{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE InstanceSigs #-}

-- |
-- Module      : Clod.Types
-- Description : Core types for the Clod application
-- Copyright   : (c) Fuzz Leonard, 2025
-- License     : MIT
-- Maintainer  : cyborg@bionicfuzz.com
-- Stability   : experimental
--
-- This module defines the core types used throughout the Clod application.
-- Clod is a utility for preparing and uploading files to Claude AI's Project Knowledge
-- feature. It tracks file changes, respects .gitignore and .clodignore patterns, and
-- optimizes filenames for Claude's UI.
--
-- The primary types include:
--
-- * 'ClodConfig' - Configuration for file processing and staging
-- * 'ClodM' - A monad for handling errors during file operations
-- * 'ClodError' - Various error types that can occur during operation
-- * 'FileResult' - Result of processing a file (success or skipped)

module Clod.Types
  ( -- * Core Types
    ClodConfig(..)
  , FileResult(..)
  , ClodError(..)
  , ClodM
  , FileEntry(..)
  , ClodDatabase(..)
  , SerializableClodDatabase(..)
  , toSerializable
  , fromSerializable
  
    -- * Type conversions and runners
  , runClodM
  , throwError
  , catchError
  , liftIO
  , ask
  , asks
  , local
  , runReaderT
  , runExceptT
  
    -- * Newtypes for type safety
  , IgnorePattern(..)
  , OptimizedName(..)
  , OriginalPath(..)
  , Checksum(..)
  
    -- * Capability types
  , FileReadCap(..)
  , FileWriteCap(..)
  , fileReadCap
  , fileWriteCap
  
    -- * Path validation
  , isPathAllowed
  ) where

import Control.Monad.Except (ExceptT, runExceptT, throwError, catchError)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Reader (ReaderT, ask, asks, local, runReaderT)
import Data.String (IsString(..))
import GHC.Generics (Generic)
import Data.List (isPrefixOf)
import System.Directory (canonicalizePath)
import Data.Time.Clock (UTCTime)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Dhall (FromDhall, ToDhall)
import Data.Aeson (FromJSON, ToJSON)

-- | Newtype for ignore patterns to prevent mixing with other string types
newtype IgnorePattern = IgnorePattern { IgnorePattern -> FilePath
unIgnorePattern :: String }
  deriving (Int -> IgnorePattern -> ShowS
[IgnorePattern] -> ShowS
IgnorePattern -> FilePath
(Int -> IgnorePattern -> ShowS)
-> (IgnorePattern -> FilePath)
-> ([IgnorePattern] -> ShowS)
-> Show IgnorePattern
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IgnorePattern -> ShowS
showsPrec :: Int -> IgnorePattern -> ShowS
$cshow :: IgnorePattern -> FilePath
show :: IgnorePattern -> FilePath
$cshowList :: [IgnorePattern] -> ShowS
showList :: [IgnorePattern] -> ShowS
Show, IgnorePattern -> IgnorePattern -> Bool
(IgnorePattern -> IgnorePattern -> Bool)
-> (IgnorePattern -> IgnorePattern -> Bool) -> Eq IgnorePattern
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IgnorePattern -> IgnorePattern -> Bool
== :: IgnorePattern -> IgnorePattern -> Bool
$c/= :: IgnorePattern -> IgnorePattern -> Bool
/= :: IgnorePattern -> IgnorePattern -> Bool
Eq, Eq IgnorePattern
Eq IgnorePattern =>
(IgnorePattern -> IgnorePattern -> Ordering)
-> (IgnorePattern -> IgnorePattern -> Bool)
-> (IgnorePattern -> IgnorePattern -> Bool)
-> (IgnorePattern -> IgnorePattern -> Bool)
-> (IgnorePattern -> IgnorePattern -> Bool)
-> (IgnorePattern -> IgnorePattern -> IgnorePattern)
-> (IgnorePattern -> IgnorePattern -> IgnorePattern)
-> Ord IgnorePattern
IgnorePattern -> IgnorePattern -> Bool
IgnorePattern -> IgnorePattern -> Ordering
IgnorePattern -> IgnorePattern -> IgnorePattern
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: IgnorePattern -> IgnorePattern -> Ordering
compare :: IgnorePattern -> IgnorePattern -> Ordering
$c< :: IgnorePattern -> IgnorePattern -> Bool
< :: IgnorePattern -> IgnorePattern -> Bool
$c<= :: IgnorePattern -> IgnorePattern -> Bool
<= :: IgnorePattern -> IgnorePattern -> Bool
$c> :: IgnorePattern -> IgnorePattern -> Bool
> :: IgnorePattern -> IgnorePattern -> Bool
$c>= :: IgnorePattern -> IgnorePattern -> Bool
>= :: IgnorePattern -> IgnorePattern -> Bool
$cmax :: IgnorePattern -> IgnorePattern -> IgnorePattern
max :: IgnorePattern -> IgnorePattern -> IgnorePattern
$cmin :: IgnorePattern -> IgnorePattern -> IgnorePattern
min :: IgnorePattern -> IgnorePattern -> IgnorePattern
Ord) via String
  deriving (FilePath -> IgnorePattern
(FilePath -> IgnorePattern) -> IsString IgnorePattern
forall a. (FilePath -> a) -> IsString a
$cfromString :: FilePath -> IgnorePattern
fromString :: FilePath -> IgnorePattern
IsString, NonEmpty IgnorePattern -> IgnorePattern
IgnorePattern -> IgnorePattern -> IgnorePattern
(IgnorePattern -> IgnorePattern -> IgnorePattern)
-> (NonEmpty IgnorePattern -> IgnorePattern)
-> (forall b. Integral b => b -> IgnorePattern -> IgnorePattern)
-> Semigroup IgnorePattern
forall b. Integral b => b -> IgnorePattern -> IgnorePattern
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: IgnorePattern -> IgnorePattern -> IgnorePattern
<> :: IgnorePattern -> IgnorePattern -> IgnorePattern
$csconcat :: NonEmpty IgnorePattern -> IgnorePattern
sconcat :: NonEmpty IgnorePattern -> IgnorePattern
$cstimes :: forall b. Integral b => b -> IgnorePattern -> IgnorePattern
stimes :: forall b. Integral b => b -> IgnorePattern -> IgnorePattern
Semigroup, Semigroup IgnorePattern
IgnorePattern
Semigroup IgnorePattern =>
IgnorePattern
-> (IgnorePattern -> IgnorePattern -> IgnorePattern)
-> ([IgnorePattern] -> IgnorePattern)
-> Monoid IgnorePattern
[IgnorePattern] -> IgnorePattern
IgnorePattern -> IgnorePattern -> IgnorePattern
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: IgnorePattern
mempty :: IgnorePattern
$cmappend :: IgnorePattern -> IgnorePattern -> IgnorePattern
mappend :: IgnorePattern -> IgnorePattern -> IgnorePattern
$cmconcat :: [IgnorePattern] -> IgnorePattern
mconcat :: [IgnorePattern] -> IgnorePattern
Monoid) via String

-- | Newtype for optimized filename used in Claude's UI
newtype OptimizedName = OptimizedName { OptimizedName -> FilePath
unOptimizedName :: String }
  deriving (Int -> OptimizedName -> ShowS
[OptimizedName] -> ShowS
OptimizedName -> FilePath
(Int -> OptimizedName -> ShowS)
-> (OptimizedName -> FilePath)
-> ([OptimizedName] -> ShowS)
-> Show OptimizedName
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OptimizedName -> ShowS
showsPrec :: Int -> OptimizedName -> ShowS
$cshow :: OptimizedName -> FilePath
show :: OptimizedName -> FilePath
$cshowList :: [OptimizedName] -> ShowS
showList :: [OptimizedName] -> ShowS
Show, OptimizedName -> OptimizedName -> Bool
(OptimizedName -> OptimizedName -> Bool)
-> (OptimizedName -> OptimizedName -> Bool) -> Eq OptimizedName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OptimizedName -> OptimizedName -> Bool
== :: OptimizedName -> OptimizedName -> Bool
$c/= :: OptimizedName -> OptimizedName -> Bool
/= :: OptimizedName -> OptimizedName -> Bool
Eq, Eq OptimizedName
Eq OptimizedName =>
(OptimizedName -> OptimizedName -> Ordering)
-> (OptimizedName -> OptimizedName -> Bool)
-> (OptimizedName -> OptimizedName -> Bool)
-> (OptimizedName -> OptimizedName -> Bool)
-> (OptimizedName -> OptimizedName -> Bool)
-> (OptimizedName -> OptimizedName -> OptimizedName)
-> (OptimizedName -> OptimizedName -> OptimizedName)
-> Ord OptimizedName
OptimizedName -> OptimizedName -> Bool
OptimizedName -> OptimizedName -> Ordering
OptimizedName -> OptimizedName -> OptimizedName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: OptimizedName -> OptimizedName -> Ordering
compare :: OptimizedName -> OptimizedName -> Ordering
$c< :: OptimizedName -> OptimizedName -> Bool
< :: OptimizedName -> OptimizedName -> Bool
$c<= :: OptimizedName -> OptimizedName -> Bool
<= :: OptimizedName -> OptimizedName -> Bool
$c> :: OptimizedName -> OptimizedName -> Bool
> :: OptimizedName -> OptimizedName -> Bool
$c>= :: OptimizedName -> OptimizedName -> Bool
>= :: OptimizedName -> OptimizedName -> Bool
$cmax :: OptimizedName -> OptimizedName -> OptimizedName
max :: OptimizedName -> OptimizedName -> OptimizedName
$cmin :: OptimizedName -> OptimizedName -> OptimizedName
min :: OptimizedName -> OptimizedName -> OptimizedName
Ord) via String
  deriving (FilePath -> OptimizedName
(FilePath -> OptimizedName) -> IsString OptimizedName
forall a. (FilePath -> a) -> IsString a
$cfromString :: FilePath -> OptimizedName
fromString :: FilePath -> OptimizedName
IsString, NonEmpty OptimizedName -> OptimizedName
OptimizedName -> OptimizedName -> OptimizedName
(OptimizedName -> OptimizedName -> OptimizedName)
-> (NonEmpty OptimizedName -> OptimizedName)
-> (forall b. Integral b => b -> OptimizedName -> OptimizedName)
-> Semigroup OptimizedName
forall b. Integral b => b -> OptimizedName -> OptimizedName
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: OptimizedName -> OptimizedName -> OptimizedName
<> :: OptimizedName -> OptimizedName -> OptimizedName
$csconcat :: NonEmpty OptimizedName -> OptimizedName
sconcat :: NonEmpty OptimizedName -> OptimizedName
$cstimes :: forall b. Integral b => b -> OptimizedName -> OptimizedName
stimes :: forall b. Integral b => b -> OptimizedName -> OptimizedName
Semigroup, Semigroup OptimizedName
OptimizedName
Semigroup OptimizedName =>
OptimizedName
-> (OptimizedName -> OptimizedName -> OptimizedName)
-> ([OptimizedName] -> OptimizedName)
-> Monoid OptimizedName
[OptimizedName] -> OptimizedName
OptimizedName -> OptimizedName -> OptimizedName
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: OptimizedName
mempty :: OptimizedName
$cmappend :: OptimizedName -> OptimizedName -> OptimizedName
mappend :: OptimizedName -> OptimizedName -> OptimizedName
$cmconcat :: [OptimizedName] -> OptimizedName
mconcat :: [OptimizedName] -> OptimizedName
Monoid) via String
  deriving ((forall x. OptimizedName -> Rep OptimizedName x)
-> (forall x. Rep OptimizedName x -> OptimizedName)
-> Generic OptimizedName
forall x. Rep OptimizedName x -> OptimizedName
forall x. OptimizedName -> Rep OptimizedName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OptimizedName -> Rep OptimizedName x
from :: forall x. OptimizedName -> Rep OptimizedName x
$cto :: forall x. Rep OptimizedName x -> OptimizedName
to :: forall x. Rep OptimizedName x -> OptimizedName
Generic)

instance FromDhall OptimizedName
instance ToDhall OptimizedName
instance FromJSON OptimizedName
instance ToJSON OptimizedName

-- | Newtype for original filepath in the repository
newtype OriginalPath = OriginalPath { OriginalPath -> FilePath
unOriginalPath :: String }
  deriving (Int -> OriginalPath -> ShowS
[OriginalPath] -> ShowS
OriginalPath -> FilePath
(Int -> OriginalPath -> ShowS)
-> (OriginalPath -> FilePath)
-> ([OriginalPath] -> ShowS)
-> Show OriginalPath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OriginalPath -> ShowS
showsPrec :: Int -> OriginalPath -> ShowS
$cshow :: OriginalPath -> FilePath
show :: OriginalPath -> FilePath
$cshowList :: [OriginalPath] -> ShowS
showList :: [OriginalPath] -> ShowS
Show, OriginalPath -> OriginalPath -> Bool
(OriginalPath -> OriginalPath -> Bool)
-> (OriginalPath -> OriginalPath -> Bool) -> Eq OriginalPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OriginalPath -> OriginalPath -> Bool
== :: OriginalPath -> OriginalPath -> Bool
$c/= :: OriginalPath -> OriginalPath -> Bool
/= :: OriginalPath -> OriginalPath -> Bool
Eq, Eq OriginalPath
Eq OriginalPath =>
(OriginalPath -> OriginalPath -> Ordering)
-> (OriginalPath -> OriginalPath -> Bool)
-> (OriginalPath -> OriginalPath -> Bool)
-> (OriginalPath -> OriginalPath -> Bool)
-> (OriginalPath -> OriginalPath -> Bool)
-> (OriginalPath -> OriginalPath -> OriginalPath)
-> (OriginalPath -> OriginalPath -> OriginalPath)
-> Ord OriginalPath
OriginalPath -> OriginalPath -> Bool
OriginalPath -> OriginalPath -> Ordering
OriginalPath -> OriginalPath -> OriginalPath
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: OriginalPath -> OriginalPath -> Ordering
compare :: OriginalPath -> OriginalPath -> Ordering
$c< :: OriginalPath -> OriginalPath -> Bool
< :: OriginalPath -> OriginalPath -> Bool
$c<= :: OriginalPath -> OriginalPath -> Bool
<= :: OriginalPath -> OriginalPath -> Bool
$c> :: OriginalPath -> OriginalPath -> Bool
> :: OriginalPath -> OriginalPath -> Bool
$c>= :: OriginalPath -> OriginalPath -> Bool
>= :: OriginalPath -> OriginalPath -> Bool
$cmax :: OriginalPath -> OriginalPath -> OriginalPath
max :: OriginalPath -> OriginalPath -> OriginalPath
$cmin :: OriginalPath -> OriginalPath -> OriginalPath
min :: OriginalPath -> OriginalPath -> OriginalPath
Ord) via String
  deriving (FilePath -> OriginalPath
(FilePath -> OriginalPath) -> IsString OriginalPath
forall a. (FilePath -> a) -> IsString a
$cfromString :: FilePath -> OriginalPath
fromString :: FilePath -> OriginalPath
IsString, NonEmpty OriginalPath -> OriginalPath
OriginalPath -> OriginalPath -> OriginalPath
(OriginalPath -> OriginalPath -> OriginalPath)
-> (NonEmpty OriginalPath -> OriginalPath)
-> (forall b. Integral b => b -> OriginalPath -> OriginalPath)
-> Semigroup OriginalPath
forall b. Integral b => b -> OriginalPath -> OriginalPath
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: OriginalPath -> OriginalPath -> OriginalPath
<> :: OriginalPath -> OriginalPath -> OriginalPath
$csconcat :: NonEmpty OriginalPath -> OriginalPath
sconcat :: NonEmpty OriginalPath -> OriginalPath
$cstimes :: forall b. Integral b => b -> OriginalPath -> OriginalPath
stimes :: forall b. Integral b => b -> OriginalPath -> OriginalPath
Semigroup, Semigroup OriginalPath
OriginalPath
Semigroup OriginalPath =>
OriginalPath
-> (OriginalPath -> OriginalPath -> OriginalPath)
-> ([OriginalPath] -> OriginalPath)
-> Monoid OriginalPath
[OriginalPath] -> OriginalPath
OriginalPath -> OriginalPath -> OriginalPath
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: OriginalPath
mempty :: OriginalPath
$cmappend :: OriginalPath -> OriginalPath -> OriginalPath
mappend :: OriginalPath -> OriginalPath -> OriginalPath
$cmconcat :: [OriginalPath] -> OriginalPath
mconcat :: [OriginalPath] -> OriginalPath
Monoid) via String
  deriving ((forall x. OriginalPath -> Rep OriginalPath x)
-> (forall x. Rep OriginalPath x -> OriginalPath)
-> Generic OriginalPath
forall x. Rep OriginalPath x -> OriginalPath
forall x. OriginalPath -> Rep OriginalPath x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OriginalPath -> Rep OriginalPath x
from :: forall x. OriginalPath -> Rep OriginalPath x
$cto :: forall x. Rep OriginalPath x -> OriginalPath
to :: forall x. Rep OriginalPath x -> OriginalPath
Generic)

instance FromDhall OriginalPath
instance ToDhall OriginalPath
instance FromJSON OriginalPath
instance ToJSON OriginalPath

-- | Configuration for the clod program
data ClodConfig = ClodConfig
  { ClodConfig -> FilePath
projectPath    :: !FilePath      -- ^ Root path of the project
  , ClodConfig -> FilePath
stagingDir     :: !FilePath      -- ^ Directory where files will be staged for Claude
  , ClodConfig -> FilePath
configDir      :: !FilePath      -- ^ Directory for configuration files
  , ClodConfig -> FilePath
databaseFile   :: !FilePath      -- ^ Path to the checksums database file
  , ClodConfig -> FilePath
timestamp      :: !String        -- ^ Timestamp for the current run
  , ClodConfig -> FilePath
currentStaging :: !FilePath      -- ^ Path to the current staging directory
  , ClodConfig -> Maybe FilePath
previousStaging :: !(Maybe FilePath) -- ^ Path to the previous staging directory, if any
  , ClodConfig -> Bool
testMode       :: !Bool          -- ^ Whether we're running in test mode
  , ClodConfig -> Bool
verbose        :: !Bool          -- ^ Whether to print verbose output
  , ClodConfig -> Bool
flushMode      :: !Bool          -- ^ Whether to flush stale entries from the database
  , ClodConfig -> Bool
lastMode       :: !Bool          -- ^ Whether to use the previous staging directory
  , ClodConfig -> [IgnorePattern]
ignorePatterns :: ![IgnorePattern] -- ^ Patterns from .gitignore and .clodignore
  } deriving stock (Int -> ClodConfig -> ShowS
[ClodConfig] -> ShowS
ClodConfig -> FilePath
(Int -> ClodConfig -> ShowS)
-> (ClodConfig -> FilePath)
-> ([ClodConfig] -> ShowS)
-> Show ClodConfig
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClodConfig -> ShowS
showsPrec :: Int -> ClodConfig -> ShowS
$cshow :: ClodConfig -> FilePath
show :: ClodConfig -> FilePath
$cshowList :: [ClodConfig] -> ShowS
showList :: [ClodConfig] -> ShowS
Show, ClodConfig -> ClodConfig -> Bool
(ClodConfig -> ClodConfig -> Bool)
-> (ClodConfig -> ClodConfig -> Bool) -> Eq ClodConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClodConfig -> ClodConfig -> Bool
== :: ClodConfig -> ClodConfig -> Bool
$c/= :: ClodConfig -> ClodConfig -> Bool
/= :: ClodConfig -> ClodConfig -> Bool
Eq, (forall x. ClodConfig -> Rep ClodConfig x)
-> (forall x. Rep ClodConfig x -> ClodConfig) -> Generic ClodConfig
forall x. Rep ClodConfig x -> ClodConfig
forall x. ClodConfig -> Rep ClodConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ClodConfig -> Rep ClodConfig x
from :: forall x. ClodConfig -> Rep ClodConfig x
$cto :: forall x. Rep ClodConfig x -> ClodConfig
to :: forall x. Rep ClodConfig x -> ClodConfig
Generic)

-- | Result of processing a file
-- 
-- * 'Success' indicates the file was successfully processed and included
-- * 'Skipped' indicates the file was skipped with a reason (matched ignore pattern, binary file, etc.)
data FileResult 
  = Success              -- ^ File was successfully processed
  | Skipped !String      -- ^ File was skipped with the given reason
  deriving stock (Int -> FileResult -> ShowS
[FileResult] -> ShowS
FileResult -> FilePath
(Int -> FileResult -> ShowS)
-> (FileResult -> FilePath)
-> ([FileResult] -> ShowS)
-> Show FileResult
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileResult -> ShowS
showsPrec :: Int -> FileResult -> ShowS
$cshow :: FileResult -> FilePath
show :: FileResult -> FilePath
$cshowList :: [FileResult] -> ShowS
showList :: [FileResult] -> ShowS
Show, FileResult -> FileResult -> Bool
(FileResult -> FileResult -> Bool)
-> (FileResult -> FileResult -> Bool) -> Eq FileResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileResult -> FileResult -> Bool
== :: FileResult -> FileResult -> Bool
$c/= :: FileResult -> FileResult -> Bool
/= :: FileResult -> FileResult -> Bool
Eq, (forall x. FileResult -> Rep FileResult x)
-> (forall x. Rep FileResult x -> FileResult) -> Generic FileResult
forall x. Rep FileResult x -> FileResult
forall x. FileResult -> Rep FileResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FileResult -> Rep FileResult x
from :: forall x. FileResult -> Rep FileResult x
$cto :: forall x. Rep FileResult x -> FileResult
to :: forall x. Rep FileResult x -> FileResult
Generic)

-- | Errors that can occur during Clod operation
--
-- These represent the different categories of errors that can occur during
-- file processing, allowing for specific error handling for each case.
data ClodError 
  = FileSystemError !FilePath !IOError -- ^ Error related to filesystem operations
  | ConfigError !String                -- ^ Error related to configuration (e.g., invalid settings)
  | PatternError !String               -- ^ Error related to pattern matching (e.g., invalid pattern)
  | CapabilityError !String            -- ^ Error related to capability validation
  | DatabaseError !String              -- ^ Error related to checksums database
  | ChecksumError !String              -- ^ Error related to checksum calculation
  deriving stock (Int -> ClodError -> ShowS
[ClodError] -> ShowS
ClodError -> FilePath
(Int -> ClodError -> ShowS)
-> (ClodError -> FilePath)
-> ([ClodError] -> ShowS)
-> Show ClodError
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClodError -> ShowS
showsPrec :: Int -> ClodError -> ShowS
$cshow :: ClodError -> FilePath
show :: ClodError -> FilePath
$cshowList :: [ClodError] -> ShowS
showList :: [ClodError] -> ShowS
Show, ClodError -> ClodError -> Bool
(ClodError -> ClodError -> Bool)
-> (ClodError -> ClodError -> Bool) -> Eq ClodError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClodError -> ClodError -> Bool
== :: ClodError -> ClodError -> Bool
$c/= :: ClodError -> ClodError -> Bool
/= :: ClodError -> ClodError -> Bool
Eq, (forall x. ClodError -> Rep ClodError x)
-> (forall x. Rep ClodError x -> ClodError) -> Generic ClodError
forall x. Rep ClodError x -> ClodError
forall x. ClodError -> Rep ClodError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ClodError -> Rep ClodError x
from :: forall x. ClodError -> Rep ClodError x
$cto :: forall x. Rep ClodError x -> ClodError
to :: forall x. Rep ClodError x -> ClodError
Generic)

-- | Newtype for file checksums to prevent mixing with other string types
newtype Checksum = Checksum { Checksum -> FilePath
unChecksum :: String }
  deriving (Int -> Checksum -> ShowS
[Checksum] -> ShowS
Checksum -> FilePath
(Int -> Checksum -> ShowS)
-> (Checksum -> FilePath) -> ([Checksum] -> ShowS) -> Show Checksum
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Checksum -> ShowS
showsPrec :: Int -> Checksum -> ShowS
$cshow :: Checksum -> FilePath
show :: Checksum -> FilePath
$cshowList :: [Checksum] -> ShowS
showList :: [Checksum] -> ShowS
Show, Checksum -> Checksum -> Bool
(Checksum -> Checksum -> Bool)
-> (Checksum -> Checksum -> Bool) -> Eq Checksum
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Checksum -> Checksum -> Bool
== :: Checksum -> Checksum -> Bool
$c/= :: Checksum -> Checksum -> Bool
/= :: Checksum -> Checksum -> Bool
Eq, Eq Checksum
Eq Checksum =>
(Checksum -> Checksum -> Ordering)
-> (Checksum -> Checksum -> Bool)
-> (Checksum -> Checksum -> Bool)
-> (Checksum -> Checksum -> Bool)
-> (Checksum -> Checksum -> Bool)
-> (Checksum -> Checksum -> Checksum)
-> (Checksum -> Checksum -> Checksum)
-> Ord Checksum
Checksum -> Checksum -> Bool
Checksum -> Checksum -> Ordering
Checksum -> Checksum -> Checksum
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Checksum -> Checksum -> Ordering
compare :: Checksum -> Checksum -> Ordering
$c< :: Checksum -> Checksum -> Bool
< :: Checksum -> Checksum -> Bool
$c<= :: Checksum -> Checksum -> Bool
<= :: Checksum -> Checksum -> Bool
$c> :: Checksum -> Checksum -> Bool
> :: Checksum -> Checksum -> Bool
$c>= :: Checksum -> Checksum -> Bool
>= :: Checksum -> Checksum -> Bool
$cmax :: Checksum -> Checksum -> Checksum
max :: Checksum -> Checksum -> Checksum
$cmin :: Checksum -> Checksum -> Checksum
min :: Checksum -> Checksum -> Checksum
Ord) via String
  deriving (FilePath -> Checksum
(FilePath -> Checksum) -> IsString Checksum
forall a. (FilePath -> a) -> IsString a
$cfromString :: FilePath -> Checksum
fromString :: FilePath -> Checksum
IsString, NonEmpty Checksum -> Checksum
Checksum -> Checksum -> Checksum
(Checksum -> Checksum -> Checksum)
-> (NonEmpty Checksum -> Checksum)
-> (forall b. Integral b => b -> Checksum -> Checksum)
-> Semigroup Checksum
forall b. Integral b => b -> Checksum -> Checksum
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Checksum -> Checksum -> Checksum
<> :: Checksum -> Checksum -> Checksum
$csconcat :: NonEmpty Checksum -> Checksum
sconcat :: NonEmpty Checksum -> Checksum
$cstimes :: forall b. Integral b => b -> Checksum -> Checksum
stimes :: forall b. Integral b => b -> Checksum -> Checksum
Semigroup, Semigroup Checksum
Checksum
Semigroup Checksum =>
Checksum
-> (Checksum -> Checksum -> Checksum)
-> ([Checksum] -> Checksum)
-> Monoid Checksum
[Checksum] -> Checksum
Checksum -> Checksum -> Checksum
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: Checksum
mempty :: Checksum
$cmappend :: Checksum -> Checksum -> Checksum
mappend :: Checksum -> Checksum -> Checksum
$cmconcat :: [Checksum] -> Checksum
mconcat :: [Checksum] -> Checksum
Monoid) via String
  deriving ((forall x. Checksum -> Rep Checksum x)
-> (forall x. Rep Checksum x -> Checksum) -> Generic Checksum
forall x. Rep Checksum x -> Checksum
forall x. Checksum -> Rep Checksum x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Checksum -> Rep Checksum x
from :: forall x. Checksum -> Rep Checksum x
$cto :: forall x. Rep Checksum x -> Checksum
to :: forall x. Rep Checksum x -> Checksum
Generic)

instance FromDhall Checksum
instance ToDhall Checksum
instance FromJSON Checksum
instance ToJSON Checksum

-- | File entry in the checksum database
data FileEntry = FileEntry
  { FileEntry -> FilePath
entryPath         :: !FilePath       -- ^ Original path
  , FileEntry -> Checksum
entryChecksum     :: !Checksum       -- ^ File content checksum
  , FileEntry -> UTCTime
entryLastModified :: !UTCTime        -- ^ Last modified time
  , FileEntry -> OptimizedName
entryOptimizedName :: !OptimizedName -- ^ Name in staging directory
  } deriving stock (Int -> FileEntry -> ShowS
[FileEntry] -> ShowS
FileEntry -> FilePath
(Int -> FileEntry -> ShowS)
-> (FileEntry -> FilePath)
-> ([FileEntry] -> ShowS)
-> Show FileEntry
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileEntry -> ShowS
showsPrec :: Int -> FileEntry -> ShowS
$cshow :: FileEntry -> FilePath
show :: FileEntry -> FilePath
$cshowList :: [FileEntry] -> ShowS
showList :: [FileEntry] -> ShowS
Show, FileEntry -> FileEntry -> Bool
(FileEntry -> FileEntry -> Bool)
-> (FileEntry -> FileEntry -> Bool) -> Eq FileEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileEntry -> FileEntry -> Bool
== :: FileEntry -> FileEntry -> Bool
$c/= :: FileEntry -> FileEntry -> Bool
/= :: FileEntry -> FileEntry -> Bool
Eq, (forall x. FileEntry -> Rep FileEntry x)
-> (forall x. Rep FileEntry x -> FileEntry) -> Generic FileEntry
forall x. Rep FileEntry x -> FileEntry
forall x. FileEntry -> Rep FileEntry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FileEntry -> Rep FileEntry x
from :: forall x. FileEntry -> Rep FileEntry x
$cto :: forall x. Rep FileEntry x -> FileEntry
to :: forall x. Rep FileEntry x -> FileEntry
Generic)
    deriving anyclass (InputNormalizer -> Decoder FileEntry
(InputNormalizer -> Decoder FileEntry) -> FromDhall FileEntry
forall a. (InputNormalizer -> Decoder a) -> FromDhall a
$cautoWith :: InputNormalizer -> Decoder FileEntry
autoWith :: InputNormalizer -> Decoder FileEntry
FromDhall, InputNormalizer -> Encoder FileEntry
(InputNormalizer -> Encoder FileEntry) -> ToDhall FileEntry
forall a. (InputNormalizer -> Encoder a) -> ToDhall a
$cinjectWith :: InputNormalizer -> Encoder FileEntry
injectWith :: InputNormalizer -> Encoder FileEntry
ToDhall, Maybe FileEntry
Value -> Parser [FileEntry]
Value -> Parser FileEntry
(Value -> Parser FileEntry)
-> (Value -> Parser [FileEntry])
-> Maybe FileEntry
-> FromJSON FileEntry
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser FileEntry
parseJSON :: Value -> Parser FileEntry
$cparseJSONList :: Value -> Parser [FileEntry]
parseJSONList :: Value -> Parser [FileEntry]
$comittedField :: Maybe FileEntry
omittedField :: Maybe FileEntry
FromJSON, [FileEntry] -> Value
[FileEntry] -> Encoding
FileEntry -> Bool
FileEntry -> Value
FileEntry -> Encoding
(FileEntry -> Value)
-> (FileEntry -> Encoding)
-> ([FileEntry] -> Value)
-> ([FileEntry] -> Encoding)
-> (FileEntry -> Bool)
-> ToJSON FileEntry
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: FileEntry -> Value
toJSON :: FileEntry -> Value
$ctoEncoding :: FileEntry -> Encoding
toEncoding :: FileEntry -> Encoding
$ctoJSONList :: [FileEntry] -> Value
toJSONList :: [FileEntry] -> Value
$ctoEncodingList :: [FileEntry] -> Encoding
toEncodingList :: [FileEntry] -> Encoding
$comitField :: FileEntry -> Bool
omitField :: FileEntry -> Bool
ToJSON)

-- | Main database structure
data ClodDatabase = ClodDatabase
  { ClodDatabase -> Map FilePath FileEntry
dbFiles          :: !(Map FilePath FileEntry)  -- ^ All tracked files by path
  , ClodDatabase -> Map FilePath FilePath
dbChecksums      :: !(Map String FilePath)     -- ^ Mapping from checksum to path (for rename detection)
  , ClodDatabase -> Maybe FilePath
dbLastStagingDir :: !(Maybe FilePath)          -- ^ Previous staging directory
  , ClodDatabase -> UTCTime
dbLastRunTime    :: !UTCTime                  -- ^ Time of last run
  } deriving stock (Int -> ClodDatabase -> ShowS
[ClodDatabase] -> ShowS
ClodDatabase -> FilePath
(Int -> ClodDatabase -> ShowS)
-> (ClodDatabase -> FilePath)
-> ([ClodDatabase] -> ShowS)
-> Show ClodDatabase
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClodDatabase -> ShowS
showsPrec :: Int -> ClodDatabase -> ShowS
$cshow :: ClodDatabase -> FilePath
show :: ClodDatabase -> FilePath
$cshowList :: [ClodDatabase] -> ShowS
showList :: [ClodDatabase] -> ShowS
Show, ClodDatabase -> ClodDatabase -> Bool
(ClodDatabase -> ClodDatabase -> Bool)
-> (ClodDatabase -> ClodDatabase -> Bool) -> Eq ClodDatabase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClodDatabase -> ClodDatabase -> Bool
== :: ClodDatabase -> ClodDatabase -> Bool
$c/= :: ClodDatabase -> ClodDatabase -> Bool
/= :: ClodDatabase -> ClodDatabase -> Bool
Eq, (forall x. ClodDatabase -> Rep ClodDatabase x)
-> (forall x. Rep ClodDatabase x -> ClodDatabase)
-> Generic ClodDatabase
forall x. Rep ClodDatabase x -> ClodDatabase
forall x. ClodDatabase -> Rep ClodDatabase x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ClodDatabase -> Rep ClodDatabase x
from :: forall x. ClodDatabase -> Rep ClodDatabase x
$cto :: forall x. Rep ClodDatabase x -> ClodDatabase
to :: forall x. Rep ClodDatabase x -> ClodDatabase
Generic)

-- | Serialization-friendly version of ClodDatabase
data SerializableClodDatabase = SerializableClodDatabase
  { SerializableClodDatabase -> [(FilePath, FileEntry)]
serializedFiles          :: ![(FilePath, FileEntry)]  -- ^ All tracked files as pairs
  , SerializableClodDatabase -> [(FilePath, FilePath)]
serializedChecksums      :: ![(String, FilePath)]     -- ^ Checksums as pairs
  , SerializableClodDatabase -> Maybe FilePath
serializedLastStagingDir :: !(Maybe FilePath)          -- ^ Previous staging directory
  , SerializableClodDatabase -> UTCTime
serializedLastRunTime    :: !UTCTime                  -- ^ Time of last run
  } deriving stock (Int -> SerializableClodDatabase -> ShowS
[SerializableClodDatabase] -> ShowS
SerializableClodDatabase -> FilePath
(Int -> SerializableClodDatabase -> ShowS)
-> (SerializableClodDatabase -> FilePath)
-> ([SerializableClodDatabase] -> ShowS)
-> Show SerializableClodDatabase
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SerializableClodDatabase -> ShowS
showsPrec :: Int -> SerializableClodDatabase -> ShowS
$cshow :: SerializableClodDatabase -> FilePath
show :: SerializableClodDatabase -> FilePath
$cshowList :: [SerializableClodDatabase] -> ShowS
showList :: [SerializableClodDatabase] -> ShowS
Show, SerializableClodDatabase -> SerializableClodDatabase -> Bool
(SerializableClodDatabase -> SerializableClodDatabase -> Bool)
-> (SerializableClodDatabase -> SerializableClodDatabase -> Bool)
-> Eq SerializableClodDatabase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SerializableClodDatabase -> SerializableClodDatabase -> Bool
== :: SerializableClodDatabase -> SerializableClodDatabase -> Bool
$c/= :: SerializableClodDatabase -> SerializableClodDatabase -> Bool
/= :: SerializableClodDatabase -> SerializableClodDatabase -> Bool
Eq, (forall x.
 SerializableClodDatabase -> Rep SerializableClodDatabase x)
-> (forall x.
    Rep SerializableClodDatabase x -> SerializableClodDatabase)
-> Generic SerializableClodDatabase
forall x.
Rep SerializableClodDatabase x -> SerializableClodDatabase
forall x.
SerializableClodDatabase -> Rep SerializableClodDatabase x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
SerializableClodDatabase -> Rep SerializableClodDatabase x
from :: forall x.
SerializableClodDatabase -> Rep SerializableClodDatabase x
$cto :: forall x.
Rep SerializableClodDatabase x -> SerializableClodDatabase
to :: forall x.
Rep SerializableClodDatabase x -> SerializableClodDatabase
Generic)
    deriving anyclass (InputNormalizer -> Decoder SerializableClodDatabase
(InputNormalizer -> Decoder SerializableClodDatabase)
-> FromDhall SerializableClodDatabase
forall a. (InputNormalizer -> Decoder a) -> FromDhall a
$cautoWith :: InputNormalizer -> Decoder SerializableClodDatabase
autoWith :: InputNormalizer -> Decoder SerializableClodDatabase
FromDhall, InputNormalizer -> Encoder SerializableClodDatabase
(InputNormalizer -> Encoder SerializableClodDatabase)
-> ToDhall SerializableClodDatabase
forall a. (InputNormalizer -> Encoder a) -> ToDhall a
$cinjectWith :: InputNormalizer -> Encoder SerializableClodDatabase
injectWith :: InputNormalizer -> Encoder SerializableClodDatabase
ToDhall, Maybe SerializableClodDatabase
Value -> Parser [SerializableClodDatabase]
Value -> Parser SerializableClodDatabase
(Value -> Parser SerializableClodDatabase)
-> (Value -> Parser [SerializableClodDatabase])
-> Maybe SerializableClodDatabase
-> FromJSON SerializableClodDatabase
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser SerializableClodDatabase
parseJSON :: Value -> Parser SerializableClodDatabase
$cparseJSONList :: Value -> Parser [SerializableClodDatabase]
parseJSONList :: Value -> Parser [SerializableClodDatabase]
$comittedField :: Maybe SerializableClodDatabase
omittedField :: Maybe SerializableClodDatabase
FromJSON, [SerializableClodDatabase] -> Value
[SerializableClodDatabase] -> Encoding
SerializableClodDatabase -> Bool
SerializableClodDatabase -> Value
SerializableClodDatabase -> Encoding
(SerializableClodDatabase -> Value)
-> (SerializableClodDatabase -> Encoding)
-> ([SerializableClodDatabase] -> Value)
-> ([SerializableClodDatabase] -> Encoding)
-> (SerializableClodDatabase -> Bool)
-> ToJSON SerializableClodDatabase
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: SerializableClodDatabase -> Value
toJSON :: SerializableClodDatabase -> Value
$ctoEncoding :: SerializableClodDatabase -> Encoding
toEncoding :: SerializableClodDatabase -> Encoding
$ctoJSONList :: [SerializableClodDatabase] -> Value
toJSONList :: [SerializableClodDatabase] -> Value
$ctoEncodingList :: [SerializableClodDatabase] -> Encoding
toEncodingList :: [SerializableClodDatabase] -> Encoding
$comitField :: SerializableClodDatabase -> Bool
omitField :: SerializableClodDatabase -> Bool
ToJSON)

-- | Convert to serializable form
toSerializable :: ClodDatabase -> SerializableClodDatabase
toSerializable :: ClodDatabase -> SerializableClodDatabase
toSerializable ClodDatabase
db = SerializableClodDatabase
  { serializedFiles :: [(FilePath, FileEntry)]
serializedFiles = Map FilePath FileEntry -> [(FilePath, FileEntry)]
forall k a. Map k a -> [(k, a)]
Map.toList (ClodDatabase -> Map FilePath FileEntry
dbFiles ClodDatabase
db)
  , serializedChecksums :: [(FilePath, FilePath)]
serializedChecksums = Map FilePath FilePath -> [(FilePath, FilePath)]
forall k a. Map k a -> [(k, a)]
Map.toList (ClodDatabase -> Map FilePath FilePath
dbChecksums ClodDatabase
db)
  , serializedLastStagingDir :: Maybe FilePath
serializedLastStagingDir = ClodDatabase -> Maybe FilePath
dbLastStagingDir ClodDatabase
db
  , serializedLastRunTime :: UTCTime
serializedLastRunTime = ClodDatabase -> UTCTime
dbLastRunTime ClodDatabase
db
  }

-- | Convert from serializable form
fromSerializable :: SerializableClodDatabase -> ClodDatabase
fromSerializable :: SerializableClodDatabase -> ClodDatabase
fromSerializable SerializableClodDatabase
sdb = ClodDatabase
  { dbFiles :: Map FilePath FileEntry
dbFiles = [(FilePath, FileEntry)] -> Map FilePath FileEntry
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (SerializableClodDatabase -> [(FilePath, FileEntry)]
serializedFiles SerializableClodDatabase
sdb)
  , dbChecksums :: Map FilePath FilePath
dbChecksums = [(FilePath, FilePath)] -> Map FilePath FilePath
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (SerializableClodDatabase -> [(FilePath, FilePath)]
serializedChecksums SerializableClodDatabase
sdb)
  , dbLastStagingDir :: Maybe FilePath
dbLastStagingDir = SerializableClodDatabase -> Maybe FilePath
serializedLastStagingDir SerializableClodDatabase
sdb
  , dbLastRunTime :: UTCTime
dbLastRunTime = SerializableClodDatabase -> UTCTime
serializedLastRunTime SerializableClodDatabase
sdb
  }

-- | The Clod monad
--
-- This monad stack combines:
--
-- * Reader for dependency injection of ClodConfig
-- * Error handling with ExceptT for 'ClodError'
-- * IO for filesystem, git, and other side effects
--
-- This replaces the previous effects-based approach with a simpler,
-- more traditional monad stack.
type ClodM a = ReaderT ClodConfig (ExceptT ClodError IO) a

-- | Run a ClodM computation, returning either an error or a result
runClodM :: ClodConfig -> ClodM a -> IO (Either ClodError a)
runClodM :: forall a. ClodConfig -> ClodM a -> IO (Either ClodError a)
runClodM ClodConfig
config ClodM a
action = ExceptT ClodError IO a -> IO (Either ClodError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ClodM a -> ClodConfig -> ExceptT ClodError IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ClodM a
action ClodConfig
config)

-- | Capability for reading files within certain directories
data FileReadCap = FileReadCap 
  { FileReadCap -> [FilePath]
allowedReadDirs :: [FilePath] -- ^ Directories where reading is permitted
  } deriving (Int -> FileReadCap -> ShowS
[FileReadCap] -> ShowS
FileReadCap -> FilePath
(Int -> FileReadCap -> ShowS)
-> (FileReadCap -> FilePath)
-> ([FileReadCap] -> ShowS)
-> Show FileReadCap
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileReadCap -> ShowS
showsPrec :: Int -> FileReadCap -> ShowS
$cshow :: FileReadCap -> FilePath
show :: FileReadCap -> FilePath
$cshowList :: [FileReadCap] -> ShowS
showList :: [FileReadCap] -> ShowS
Show, FileReadCap -> FileReadCap -> Bool
(FileReadCap -> FileReadCap -> Bool)
-> (FileReadCap -> FileReadCap -> Bool) -> Eq FileReadCap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileReadCap -> FileReadCap -> Bool
== :: FileReadCap -> FileReadCap -> Bool
$c/= :: FileReadCap -> FileReadCap -> Bool
/= :: FileReadCap -> FileReadCap -> Bool
Eq)

-- | Capability for writing files within certain directories
data FileWriteCap = FileWriteCap 
  { FileWriteCap -> [FilePath]
allowedWriteDirs :: [FilePath] -- ^ Directories where writing is permitted
  } deriving (Int -> FileWriteCap -> ShowS
[FileWriteCap] -> ShowS
FileWriteCap -> FilePath
(Int -> FileWriteCap -> ShowS)
-> (FileWriteCap -> FilePath)
-> ([FileWriteCap] -> ShowS)
-> Show FileWriteCap
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileWriteCap -> ShowS
showsPrec :: Int -> FileWriteCap -> ShowS
$cshow :: FileWriteCap -> FilePath
show :: FileWriteCap -> FilePath
$cshowList :: [FileWriteCap] -> ShowS
showList :: [FileWriteCap] -> ShowS
Show, FileWriteCap -> FileWriteCap -> Bool
(FileWriteCap -> FileWriteCap -> Bool)
-> (FileWriteCap -> FileWriteCap -> Bool) -> Eq FileWriteCap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileWriteCap -> FileWriteCap -> Bool
== :: FileWriteCap -> FileWriteCap -> Bool
$c/= :: FileWriteCap -> FileWriteCap -> Bool
/= :: FileWriteCap -> FileWriteCap -> Bool
Eq)

-- | Create a file read capability for specified directories
fileReadCap :: [FilePath] -> FileReadCap
fileReadCap :: [FilePath] -> FileReadCap
fileReadCap [FilePath]
dirs = FileReadCap { allowedReadDirs :: [FilePath]
allowedReadDirs = [FilePath]
dirs }

-- | Create a file write capability for specified directories
fileWriteCap :: [FilePath] -> FileWriteCap
fileWriteCap :: [FilePath] -> FileWriteCap
fileWriteCap [FilePath]
dirs = FileWriteCap { allowedWriteDirs :: [FilePath]
allowedWriteDirs = [FilePath]
dirs }

-- | Check if a path is within allowed directories
-- This improved version handles path traversal attacks by comparing canonical paths
isPathAllowed :: [FilePath] -> FilePath -> IO Bool
isPathAllowed :: [FilePath] -> FilePath -> IO Bool
isPathAllowed [FilePath]
allowedDirs FilePath
path = do
  -- Get canonical paths to resolve any `.`, `..`, or symlinks
  canonicalPath <- FilePath -> IO FilePath
canonicalizePath FilePath
path
  -- Check if the canonical path is within any of the allowed directories
  checks <- mapM (\FilePath
dir -> do
                   canonicalDir <- FilePath -> IO FilePath
canonicalizePath FilePath
dir
                   -- A path is allowed if:
                   -- 1. It equals an allowed directory exactly, or
                   -- 2. It's a proper subdirectory (dir is a prefix and has a path separator)
                   let isAllowed = FilePath
canonicalDir FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
canonicalPath Bool -> Bool -> Bool
|| 
                                  (FilePath
canonicalDir FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
canonicalPath Bool -> Bool -> Bool
&& 
                                   FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
canonicalPath Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
canonicalDir Bool -> Bool -> Bool
&&
                                   Char -> Bool
isPathSeparator (FilePath
canonicalPath FilePath -> Int -> Char
forall a. HasCallStack => [a] -> Int -> a
!! FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
canonicalDir))
                   return isAllowed) allowedDirs
  -- Return result
  return (or checks)
  where
    isPathSeparator :: Char -> Bool
isPathSeparator Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\'