{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Provides 'PathData' for use with the Json backend.
module Charon.Backend.Json.PathData
  ( -- * PathData
    PathData (..),
    toPathData,
    toCorePathData,
    fromCorePathData,
  )
where

import Charon.Backend.Default.Utils qualified as Default.Utils
import Charon.Class.Serial (Serial (DecodeExtra, decode, encode))
import Charon.Data.PathData qualified as PathData
import Charon.Data.PathType (PathTypeW)
import Charon.Data.Paths
  ( PathI (MkPathI),
    PathIndex
      ( TrashEntryFileName,
        TrashEntryOriginalPath,
        TrashHome
      ),
  )
import Charon.Data.Timestamp (Timestamp)
import Charon.Prelude
import Charon.Utils qualified as Utils
import Data.Aeson
  ( FromJSON (parseJSON),
    KeyValue ((.=)),
    ToJSON (toJSON),
    (.:),
  )
import Data.Aeson qualified as Asn
import Data.ByteString.Lazy qualified as BSL

-- | Data for an Fdo path. Maintains an invariant that the original path is not
-- the root nor is it empty.
data PathData = UnsafePathData
  { -- | The path type.
    PathData -> PathTypeW
pathType :: PathTypeW,
    -- | The path to be used in the trash directory.
    PathData -> PathI 'TrashEntryFileName
fileName :: PathI TrashEntryFileName,
    -- | The original path on the file system.
    PathData -> PathI 'TrashEntryOriginalPath
originalPath :: PathI TrashEntryOriginalPath,
    -- | Time this entry was created.
    PathData -> Timestamp
created :: Timestamp,
    -- | The size.
    PathData -> Bytes 'B Natural
size :: Bytes B Natural
  }
  deriving stock (PathData -> PathData -> Bool
(PathData -> PathData -> Bool)
-> (PathData -> PathData -> Bool) -> Eq PathData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PathData -> PathData -> Bool
== :: PathData -> PathData -> Bool
$c/= :: PathData -> PathData -> Bool
/= :: PathData -> PathData -> Bool
Eq, (forall x. PathData -> Rep PathData x)
-> (forall x. Rep PathData x -> PathData) -> Generic PathData
forall x. Rep PathData x -> PathData
forall x. PathData -> Rep PathData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PathData -> Rep PathData x
from :: forall x. PathData -> Rep PathData x
$cto :: forall x. Rep PathData x -> PathData
to :: forall x. Rep PathData x -> PathData
Generic, Int -> PathData -> ShowS
[PathData] -> ShowS
PathData -> String
(Int -> PathData -> ShowS)
-> (PathData -> String) -> ([PathData] -> ShowS) -> Show PathData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PathData -> ShowS
showsPrec :: Int -> PathData -> ShowS
$cshow :: PathData -> String
show :: PathData -> String
$cshowList :: [PathData] -> ShowS
showList :: [PathData] -> ShowS
Show)
  deriving anyclass (Eq PathData
Eq PathData =>
(Int -> PathData -> Int) -> (PathData -> Int) -> Hashable PathData
Int -> PathData -> Int
PathData -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> PathData -> Int
hashWithSalt :: Int -> PathData -> Int
$chash :: PathData -> Int
hash :: PathData -> Int
Hashable, PathData -> ()
(PathData -> ()) -> NFData PathData
forall a. (a -> ()) -> NFData a
$crnf :: PathData -> ()
rnf :: PathData -> ()
NFData)

makeFieldLabelsNoPrefix ''PathData

-- | For a given filepath, attempts to capture the following data:
--
-- * Canonical path.
-- * Unique name to be used in the trash directory.
-- * File/directory type.
toPathData ::
  ( HasCallStack,
    MonadAsync m,
    MonadCatch m,
    MonadLoggerNS m,
    MonadPathReader m,
    MonadPosixCompat m,
    MonadTerminal m
  ) =>
  Timestamp ->
  PathI TrashHome ->
  PathI TrashEntryOriginalPath ->
  m (PathData, PathTypeW)
toPathData :: forall (m :: * -> *).
(HasCallStack, MonadAsync m, MonadCatch m, MonadLoggerNS m,
 MonadPathReader m, MonadPosixCompat m, MonadTerminal m) =>
Timestamp
-> PathI 'TrashHome
-> PathI 'TrashEntryOriginalPath
-> m (PathData, PathTypeW)
toPathData Timestamp
currTime PathI 'TrashHome
trashHome PathI 'TrashEntryOriginalPath
origPath = Text -> m (PathData, PathTypeW) -> m (PathData, PathTypeW)
forall (m :: * -> *) a. MonadLoggerNS m => Text -> m a -> m a
addNamespace Text
"toPathData" (m (PathData, PathTypeW) -> m (PathData, PathTypeW))
-> m (PathData, PathTypeW) -> m (PathData, PathTypeW)
forall a b. (a -> b) -> a -> b
$ do
  (PathI 'TrashEntryFileName
fileName', PathI 'TrashEntryOriginalPath
originalPath', PathTypeW
pathType) <- PathI 'TrashHome
-> PathI 'TrashEntryOriginalPath
-> m (PathI 'TrashEntryFileName, PathI 'TrashEntryOriginalPath,
      PathTypeW)
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadLoggerNS m, MonadPathReader m) =>
PathI 'TrashHome
-> PathI 'TrashEntryOriginalPath
-> m (PathI 'TrashEntryFileName, PathI 'TrashEntryOriginalPath,
      PathTypeW)
Default.Utils.getPathInfo PathI 'TrashHome
trashHome PathI 'TrashEntryOriginalPath
origPath
  Bytes 'B Natural
size <- OsPath -> m (Bytes 'B Natural)
forall (m :: * -> *).
(HasCallStack, MonadAsync m, MonadCatch m, MonadLoggerNS m,
 MonadPathReader m, MonadPosixCompat m, MonadTerminal m) =>
OsPath -> m (Bytes 'B Natural)
Utils.getPathSize (PathI 'TrashEntryOriginalPath
origPath PathI 'TrashEntryOriginalPath
-> Optic' An_Iso NoIx (PathI 'TrashEntryOriginalPath) OsPath
-> OsPath
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' An_Iso NoIx (PathI 'TrashEntryOriginalPath) OsPath
#unPathI)

  (PathData, PathTypeW) -> m (PathData, PathTypeW)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( UnsafePathData
        { PathTypeW
$sel:pathType:UnsafePathData :: PathTypeW
pathType :: PathTypeW
pathType,
          $sel:fileName:UnsafePathData :: PathI 'TrashEntryFileName
fileName = PathI 'TrashEntryFileName
fileName',
          $sel:originalPath:UnsafePathData :: PathI 'TrashEntryOriginalPath
originalPath = PathI 'TrashEntryOriginalPath
originalPath',
          $sel:created:UnsafePathData :: Timestamp
created = Timestamp
currTime,
          Bytes 'B Natural
$sel:size:UnsafePathData :: Bytes 'B Natural
size :: Bytes 'B Natural
size
        },
      PathTypeW
pathType
    )

newtype PathDataJSON = MkPathDataJSON (PathTypeW, FilePath, Timestamp, Natural)

instance ToJSON PathDataJSON where
  toJSON :: PathDataJSON -> Value
toJSON (MkPathDataJSON (PathTypeW
pathType, String
opathStr, Timestamp
ts, Natural
size)) =
    [Pair] -> Value
Asn.object
      [ Key
"pathType" Key -> PathTypeW -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= PathTypeW
pathType,
        Key
"path" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= String
opathStr,
        Key
"created" Key -> Timestamp -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Timestamp
ts,
        Key
"size" Key -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Natural
size
      ]

instance FromJSON PathDataJSON where
  parseJSON :: Value -> Parser PathDataJSON
parseJSON = String
-> (Object -> Parser PathDataJSON) -> Value -> Parser PathDataJSON
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Asn.withObject String
"PathDataJSON" ((Object -> Parser PathDataJSON) -> Value -> Parser PathDataJSON)
-> (Object -> Parser PathDataJSON) -> Value -> Parser PathDataJSON
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    ((PathTypeW, String, Timestamp, Natural) -> PathDataJSON)
-> Parser (PathTypeW, String, Timestamp, Natural)
-> Parser PathDataJSON
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PathTypeW, String, Timestamp, Natural) -> PathDataJSON
MkPathDataJSON
      (Parser (PathTypeW, String, Timestamp, Natural)
 -> Parser PathDataJSON)
-> Parser (PathTypeW, String, Timestamp, Natural)
-> Parser PathDataJSON
forall a b. (a -> b) -> a -> b
$ (,,,)
      (PathTypeW
 -> String
 -> Timestamp
 -> Natural
 -> (PathTypeW, String, Timestamp, Natural))
-> Parser PathTypeW
-> Parser
     (String
      -> Timestamp -> Natural -> (PathTypeW, String, Timestamp, Natural))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v
      Object -> Key -> Parser PathTypeW
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"pathType"
      Parser
  (String
   -> Timestamp -> Natural -> (PathTypeW, String, Timestamp, Natural))
-> Parser String
-> Parser
     (Timestamp -> Natural -> (PathTypeW, String, Timestamp, Natural))
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
      Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"path"
      Parser
  (Timestamp -> Natural -> (PathTypeW, String, Timestamp, Natural))
-> Parser Timestamp
-> Parser (Natural -> (PathTypeW, String, Timestamp, Natural))
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
      Object -> Key -> Parser Timestamp
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created"
      Parser (Natural -> (PathTypeW, String, Timestamp, Natural))
-> Parser Natural -> Parser (PathTypeW, String, Timestamp, Natural)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
      Object -> Key -> Parser Natural
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"size"

instance Serial PathData where
  type DecodeExtra PathData = PathI TrashEntryFileName

  encode :: PathData -> Either String ByteString
  encode :: PathData -> Either String ByteString
encode (UnsafePathData PathTypeW
pathType PathI 'TrashEntryFileName
_ (MkPathI OsPath
opath) Timestamp
ts (MkBytes Natural
sz)) =
    (EncodingException -> String)
-> (String -> ByteString)
-> Either EncodingException String
-> Either String ByteString
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap
      EncodingException -> String
forall e. Exception e => e -> String
displayException
      (ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString)
-> (String -> ByteString) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathDataJSON -> ByteString
forall a. ToJSON a => a -> ByteString
Asn.encode (PathDataJSON -> ByteString)
-> (String -> PathDataJSON) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PathTypeW, String, Timestamp, Natural) -> PathDataJSON
MkPathDataJSON ((PathTypeW, String, Timestamp, Natural) -> PathDataJSON)
-> (String -> (PathTypeW, String, Timestamp, Natural))
-> String
-> PathDataJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PathTypeW
pathType,,Timestamp
ts,Natural
sz))
      (OsPath -> Either EncodingException String
decodeOsToFp OsPath
opath)

  decode :: PathI TrashEntryFileName -> ByteString -> Either String PathData
  decode :: PathI 'TrashEntryFileName -> ByteString -> Either String PathData
decode PathI 'TrashEntryFileName
name ByteString
bs = do
    MkPathDataJSON (PathTypeW
pathType, String
opathStr, Timestamp
ts, Natural
sz) <- ByteString -> Either String PathDataJSON
forall a. FromJSON a => ByteString -> Either String a
Asn.eitherDecode (ByteString -> Either String PathDataJSON)
-> ByteString -> Either String PathDataJSON
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSL.fromStrict ByteString
bs

    (EncodingException -> String)
-> (OsPath -> PathData)
-> Either EncodingException OsPath
-> Either String PathData
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap
      EncodingException -> String
forall e. Exception e => e -> String
displayException
      (\OsPath
opath -> PathTypeW
-> PathI 'TrashEntryFileName
-> PathI 'TrashEntryOriginalPath
-> Timestamp
-> Bytes 'B Natural
-> PathData
UnsafePathData PathTypeW
pathType PathI 'TrashEntryFileName
name (OsPath -> PathI 'TrashEntryOriginalPath
forall (i :: PathIndex). OsPath -> PathI i
MkPathI OsPath
opath) Timestamp
ts (Natural -> Bytes 'B Natural
forall (s :: Size) n. n -> Bytes s n
MkBytes Natural
sz))
      (String -> Either EncodingException OsPath
encodeFpToOs String
opathStr)

toCorePathData :: PathData -> PathData.PathData
toCorePathData :: PathData -> PathData
toCorePathData PathData
pd =
  PathData.UnsafePathData
    { $sel:pathType:UnsafePathData :: PathTypeW
pathType = PathData
pd PathData -> Optic' A_Lens NoIx PathData PathTypeW -> PathTypeW
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx PathData PathTypeW
#pathType,
      $sel:fileName:UnsafePathData :: PathI 'TrashEntryFileName
fileName = PathData
pd PathData
-> Optic' A_Lens NoIx PathData (PathI 'TrashEntryFileName)
-> PathI 'TrashEntryFileName
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx PathData (PathI 'TrashEntryFileName)
#fileName,
      $sel:originalPath:UnsafePathData :: PathI 'TrashEntryOriginalPath
originalPath = PathData
pd PathData
-> Optic' A_Lens NoIx PathData (PathI 'TrashEntryOriginalPath)
-> PathI 'TrashEntryOriginalPath
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx PathData (PathI 'TrashEntryOriginalPath)
#originalPath,
      $sel:created:UnsafePathData :: Timestamp
created = PathData
pd PathData -> Optic' A_Lens NoIx PathData Timestamp -> Timestamp
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx PathData Timestamp
#created,
      $sel:size:UnsafePathData :: Bytes 'B Natural
size = PathData
pd PathData
-> Optic' A_Lens NoIx PathData (Bytes 'B Natural)
-> Bytes 'B Natural
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx PathData (Bytes 'B Natural)
#size
    }

fromCorePathData :: PathData.PathData -> PathData
fromCorePathData :: PathData -> PathData
fromCorePathData PathData
pd =
  UnsafePathData
    { $sel:pathType:UnsafePathData :: PathTypeW
pathType = PathData
pd PathData -> Optic' A_Lens NoIx PathData PathTypeW -> PathTypeW
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx PathData PathTypeW
#pathType,
      $sel:fileName:UnsafePathData :: PathI 'TrashEntryFileName
fileName = PathData
pd PathData
-> Optic' A_Lens NoIx PathData (PathI 'TrashEntryFileName)
-> PathI 'TrashEntryFileName
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx PathData (PathI 'TrashEntryFileName)
#fileName,
      $sel:originalPath:UnsafePathData :: PathI 'TrashEntryOriginalPath
originalPath = PathData
pd PathData
-> Optic' A_Lens NoIx PathData (PathI 'TrashEntryOriginalPath)
-> PathI 'TrashEntryOriginalPath
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx PathData (PathI 'TrashEntryOriginalPath)
#originalPath,
      $sel:created:UnsafePathData :: Timestamp
created = PathData
pd PathData -> Optic' A_Lens NoIx PathData Timestamp -> Timestamp
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx PathData Timestamp
#created,
      $sel:size:UnsafePathData :: Bytes 'B Natural
size = PathData
pd PathData
-> Optic' A_Lens NoIx PathData (Bytes 'B Natural)
-> Bytes 'B Natural
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx PathData (Bytes 'B Natural)
#size
    }