-- | Local repository
module Hackage.Security.Client.Repository.Local (
    LocalRepo
  , LocalFile -- opaque
  , withRepository
  ) where

import Prelude
import Hackage.Security.Client.Formats
import Hackage.Security.Client.Repository
import Hackage.Security.Client.Repository.Cache
import Hackage.Security.Client.Verify
import Hackage.Security.TUF
import Hackage.Security.Trusted
import Hackage.Security.Util.IO
import Hackage.Security.Util.Path
import Hackage.Security.Util.Pretty
import Hackage.Security.Util.Some

-- | Location of the repository
--
-- Note that we regard the local repository as immutable; we cache files just
-- like we do for remote repositories.
type LocalRepo = Path Absolute

-- | Initialize the repository (and cleanup resources afterwards)
--
-- Like a remote repository, a local repository takes a RepoLayout as argument;
-- but where the remote repository interprets this RepoLayout relative to a URL,
-- the local repository interprets it relative to a local directory.
--
-- It uses the same cache as the remote repository.
withRepository
  :: LocalRepo                       -- ^ Location of local repository
  -> Cache                           -- ^ Location of local cache
  -> RepoLayout                      -- ^ Repository layout
  -> IndexLayout                     -- ^ Index layout
  -> (LogMessage -> IO ())           -- ^ Logger
  -> (Repository LocalFile -> IO a)  -- ^ Callback
  -> IO a
withRepository :: forall a.
LocalRepo
-> Cache
-> RepoLayout
-> IndexLayout
-> (LogMessage -> IO ())
-> (Repository LocalFile -> IO a)
-> IO a
withRepository LocalRepo
repo
               Cache
cache
               RepoLayout
repLayout
               IndexLayout
repIndexLayout
               LogMessage -> IO ()
logger
               Repository LocalFile -> IO a
callback
               =
  Repository LocalFile -> IO a
callback Repository {
      repGetRemote :: forall fs typ.
Throws SomeRemoteError =>
AttemptNr
-> RemoteFile fs typ -> Verify (Some (HasFormat fs), LocalFile typ)
repGetRemote     = RepoLayout
-> LocalRepo
-> Cache
-> AttemptNr
-> RemoteFile fs typ
-> Verify (Some (HasFormat fs), LocalFile typ)
forall fs typ.
RepoLayout
-> LocalRepo
-> Cache
-> AttemptNr
-> RemoteFile fs typ
-> Verify (Some (HasFormat fs), LocalFile typ)
getRemote RepoLayout
repLayout LocalRepo
repo Cache
cache
    , repGetCached :: CachedFile -> IO (Maybe LocalRepo)
repGetCached     = Cache -> CachedFile -> IO (Maybe LocalRepo)
getCached     Cache
cache
    , repGetCachedRoot :: IO LocalRepo
repGetCachedRoot = Cache -> IO LocalRepo
getCachedRoot Cache
cache
    , repClearCache :: IO ()
repClearCache    = Cache -> IO ()
clearCache    Cache
cache
    , repWithIndex :: forall a. (Handle -> IO a) -> IO a
repWithIndex     = Cache -> (Handle -> IO a) -> IO a
forall a. Cache -> (Handle -> IO a) -> IO a
withIndex     Cache
cache
    , repGetIndexIdx :: IO TarIndex
repGetIndexIdx   = Cache -> IO TarIndex
getIndexIdx   Cache
cache
    , repLockCache :: IO () -> IO ()
repLockCache     = (LogMessage -> IO ()) -> Cache -> IO () -> IO ()
lockCacheWithLogger LogMessage -> IO ()
logger Cache
cache
    , repWithMirror :: forall a. Maybe [Mirror] -> IO a -> IO a
repWithMirror    = Maybe [Mirror] -> IO a -> IO a
forall a. Maybe [Mirror] -> IO a -> IO a
mirrorsUnsupported
    , repLog :: LogMessage -> IO ()
repLog           = LogMessage -> IO ()
logger
    , repLayout :: RepoLayout
repLayout        = RepoLayout
repLayout
    , repIndexLayout :: IndexLayout
repIndexLayout   = IndexLayout
repIndexLayout
    , repDescription :: String
repDescription   = String
"Local repository at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ LocalRepo -> String
forall a. Pretty a => a -> String
pretty LocalRepo
repo
    }

-- | Get a file from the server
getRemote :: RepoLayout -> LocalRepo -> Cache
          -> AttemptNr
          -> RemoteFile fs typ
          -> Verify (Some (HasFormat fs), LocalFile typ)
getRemote :: forall fs typ.
RepoLayout
-> LocalRepo
-> Cache
-> AttemptNr
-> RemoteFile fs typ
-> Verify (Some (HasFormat fs), LocalFile typ)
getRemote RepoLayout
repoLayout LocalRepo
repo Cache
cache AttemptNr
_attemptNr RemoteFile fs typ
remoteFile = do
    case RemoteFile fs typ -> Some (HasFormat fs)
forall fs typ. RemoteFile fs typ -> Some (HasFormat fs)
remoteFileDefaultFormat RemoteFile fs typ
remoteFile of
      Some HasFormat fs a
format -> do
        let remotePath' :: RepoPath
remotePath' = RepoLayout -> RemoteFile fs typ -> HasFormat fs a -> RepoPath
forall fs typ f.
RepoLayout -> RemoteFile fs typ -> HasFormat fs f -> RepoPath
remoteRepoPath' RepoLayout
repoLayout RemoteFile fs typ
remoteFile HasFormat fs a
format
            remotePath :: LocalRepo
remotePath  = LocalRepo -> RepoPath -> LocalRepo
forall root. Path root -> RepoPath -> Path root
anchorRepoPathLocally LocalRepo
repo RepoPath
remotePath'
            localFile :: LocalFile typ
localFile   = LocalRepo -> LocalFile typ
forall a. LocalRepo -> LocalFile a
LocalFile LocalRepo
remotePath
        IO () -> Verify ()
ifVerified (IO () -> Verify ()) -> IO () -> Verify ()
forall a b. (a -> b) -> a -> b
$
          Cache -> LocalFile typ -> Format a -> IsCached typ -> IO ()
forall (down :: * -> *) typ f.
DownloadedFile down =>
Cache -> down typ -> Format f -> IsCached typ -> IO ()
cacheRemoteFile Cache
cache
                          LocalFile typ
localFile
                          (HasFormat fs a -> Format a
forall fs f. HasFormat fs f -> Format f
hasFormatGet HasFormat fs a
format)
                          (RemoteFile fs typ -> IsCached typ
forall fs typ. RemoteFile fs typ -> IsCached typ
mustCache RemoteFile fs typ
remoteFile)
        (Some (HasFormat fs), LocalFile typ)
-> Verify (Some (HasFormat fs), LocalFile typ)
forall a. a -> Verify a
forall (m :: * -> *) a. Monad m => a -> m a
return (HasFormat fs a -> Some (HasFormat fs)
forall (f :: * -> *) a. f a -> Some f
Some HasFormat fs a
format, LocalFile typ
localFile)

{-------------------------------------------------------------------------------
  Files in the local repository
-------------------------------------------------------------------------------}

newtype LocalFile a = LocalFile (Path Absolute)

instance DownloadedFile LocalFile where
  downloadedVerify :: forall a. LocalFile a -> Trusted FileInfo -> IO Bool
downloadedVerify = LocalFile a -> Trusted FileInfo -> IO Bool
forall a. LocalFile a -> Trusted FileInfo -> IO Bool
verifyLocalFile
  downloadedRead :: LocalFile Metadata -> IO ByteString
downloadedRead   = \(LocalFile LocalRepo
local) -> LocalRepo -> IO ByteString
forall root. FsRoot root => Path root -> IO ByteString
readLazyByteString LocalRepo
local
  downloadedCopyTo :: forall a. LocalFile a -> LocalRepo -> IO ()
downloadedCopyTo = \(LocalFile LocalRepo
local) -> LocalRepo -> LocalRepo -> IO ()
forall root root'.
(FsRoot root, FsRoot root') =>
Path root -> Path root' -> IO ()
copyFile LocalRepo
local

verifyLocalFile :: LocalFile typ -> Trusted FileInfo -> IO Bool
verifyLocalFile :: forall a. LocalFile a -> Trusted FileInfo -> IO Bool
verifyLocalFile (LocalFile LocalRepo
fp) Trusted FileInfo
trustedInfo = do
    -- Verify the file size before comparing the entire file info
    FileLength
sz <- Int54 -> FileLength
FileLength (Int54 -> FileLength) -> IO Int54 -> IO FileLength
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LocalRepo -> IO Int54
forall a root. (Num a, FsRoot root) => Path root -> IO a
getFileSize LocalRepo
fp
    if FileLength
sz FileLength -> FileLength -> Bool
forall a. Eq a => a -> a -> Bool
/= FileInfo -> FileLength
fileInfoLength (Trusted FileInfo -> FileInfo
forall a. Trusted a -> a
trusted Trusted FileInfo
trustedInfo)
      then Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      else FileInfo -> FileInfo -> Bool
compareTrustedFileInfo (Trusted FileInfo -> FileInfo
forall a. Trusted a -> a
trusted Trusted FileInfo
trustedInfo) (FileInfo -> Bool) -> IO FileInfo -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LocalRepo -> IO FileInfo
forall root. FsRoot root => Path root -> IO FileInfo
computeFileInfo LocalRepo
fp