Cache.hs

{-|
Module      : MptcpAnalyzer.Cache
Description : Save into/load from a local cache
Maintainer  : matt
License     : GPL-3
-}

{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}
module MptcpAnalyzer.Cache (
  CacheId(..)
  , Cache(..)
  , CacheConfig(..)
  , runMockCache
  , getCache
  , putCache
  , runCache
)
where

import MptcpAnalyzer.Pcap
import MptcpAnalyzer.Types

import Prelude hiding (writeFile)
import System.Directory (doesFileExist)
-- import System.Posix.Files.ByteString
import Control.Exception as CE
import Data.ByteString (writeFile)
import Data.Hashable
import Data.List (intercalate)
import Data.Serialize
import Frames
import Frames.CSV
import GHC.Generics
import Polysemy
import System.FilePath.Posix (takeBaseName)


-- | Cache item identifier
data CacheId = CacheId {
  cacheDeps :: [FilePath]
  , cachePrefix :: String
  , cacheSuffix :: String
} deriving (Generic, Show, Eq, Hashable)

-- | Cache config (this is a test)
-- test
data CacheConfig = CacheConfig {
  -- | Folder where to store stuff
  cacheFolder :: FilePath
  -- | Whether the cachie is fixed
  , cacheEnabled :: Bool
} deriving Show

-- class Serializable a where
--   encode :: a -> String
--   decode :: String -> a

-- TODO add a cacheConfig ?
-- TODO this should be an effect
data Cache m a where
    -- should maybe be a filepath
    PutCache :: Serialize res => CacheId -> res -> Cache m Bool
    GetCache :: Serialize res => CacheId -> Cache m (Either String res)
    IsValid :: CacheId -> Cache m Bool

makeSem ''Cache

filenameFromCacheId :: CacheId -> FilePath
filenameFromCacheId cid =
    cachePrefix cid ++ intercalate "_" basenames ++ show myHash ++ cacheSuffix cid
    where
        basenames = map takeBaseName $ cacheDeps cid
        -- TODO
        -- "hash"
        myHash = hash basenames

-- Return full path to the config folder
getFullPath :: CacheConfig -> CacheId -> FilePath
getFullPath config cid = cacheFolder config ++ "/" ++ filenameFromCacheId cid


-- TODO pass cache config
runCache :: Members '[Embed IO] r => CacheConfig -> Sem (Cache : r) a -> Sem r a
runCache config = do
  interpret $ \case
      PutCache cid frame -> doPutCache config cid frame
      GetCache cid -> doGetCache config cid
        -- return $ Left "not implemented"
        -- use config to get the final path too
        -- let csvFilename = filenameFromCacheId cid
        -- rpcap <- embed $ loadRows csvFilename
        -- return Right rpcap
      IsValid cid -> isCacheValid config cid

-- | Mock cache
--
runMockCache :: Members '[Embed IO] r => CacheConfig -> Sem (Cache : r) a -> Sem r a
runMockCache config = do
  interpret $ \case
      PutCache cid frame -> return True
      GetCache cid -> return $ Left "Not in cache"
        -- return $ Left "not implemented"
        -- use config to get the final path too
        -- let csvFilename = filenameFromCacheId cid
        -- rpcap <- embed $ loadRows csvFilename
        -- return Right rpcap
      IsValid cid -> return False

-- first check if the file exists ?
doGetCache :: (Serialize a, Members '[Embed IO] r)
  => CacheConfig
  -> CacheId
  -> Sem r (Either String a)
doGetCache config cid = return $ Left "Not implemented yet"
  -- do
  -- -- res <- embed $ loadRows csvFilename
  -- -- exists <- embed $ fileExist csvFilename
  -- res <- embed $ CE.try @IOException $ loadRows csvFilename
  -- case res of
  --   Left _excpt -> return $ Left "Exception"
  --   Right x -> return (Right x)
  -- where
  --     csvFilename = getFullPath config cid


-- TODO reuse export function ?
doPutCache :: (Serialize a, Members '[Embed IO] r)
  => CacheConfig -> CacheId -> a -> Sem r Bool
doPutCache config cid resource =
  -- writeFile
  -- writeCSV :: (ColumnHeaders ts, Foldable f, RecordToList ts, RecMapMethod ShowCSV ElField ts) => FilePath -> f (Record ts) -> IO ()
  -- produceDSV
  -- embed $ writeCSV csvFilename frame >> return True
  embed $ do
    writeFile csvFilename $ encode resource
    return True
  where
      csvFilename = getFullPath config cid


-- TODO log ? / compare inputs date
isCacheValid :: Members '[Embed IO] r => CacheConfig -> CacheId -> Sem r Bool
isCacheValid config cid =
  embed $ doesFileExist filename
  where
    filename = getFullPath config cid