{-| Effectful functions executing shared image respository operations.
    See "B9.Repository" -}
module B9.RepositoryIO
  ( repoSearch
  , pushToRepo
  , pullFromRepo
  , pullGlob
  , Repository(..)
  , toRemoteRepository
  , FilePathGlob(..)
  ) where

import B9.B9Config (getRemoteRepos)
import B9.B9Logging
import B9.B9Exec
import B9.Repository
import Control.Eff
import Control.Monad.IO.Class
import Data.List
import System.Directory
import System.FilePath
import System.IO.B9Extras (ensureDir)
import Text.Printf (printf)

data Repository
  = Cache
  | Remote String
  deriving (Eq, Ord, Read, Show)

-- | Convert a `RemoteRepo` down to a mere `Repository`
toRemoteRepository :: RemoteRepo -> Repository
toRemoteRepository = Remote . remoteRepoRepoId

-- | Find files which are in 'subDir' and match 'glob' in the repository
-- cache. NOTE: This operates on the repository cache, but does not enforce a
-- repository cache update.
repoSearch ::
     forall e. (CommandIO e, Member RepoCacheReader e)
  => FilePath
  -> FilePathGlob
  -> Eff e [(Repository, [FilePath])]
repoSearch subDir glob = (:) <$> localMatches <*> remoteRepoMatches
  where
    remoteRepoMatches = do
      remoteRepos <- getRemoteRepos
      mapM remoteRepoSearch remoteRepos
    localMatches :: Eff e (Repository, [FilePath])
    localMatches = do
      cache <- getRepoCache
      let dir = localRepoDir cache </> subDir
      files <- findGlob dir
      return (Cache, files)
    remoteRepoSearch :: RemoteRepo -> Eff e (Repository, [FilePath])
    remoteRepoSearch repo = do
      cache <- getRepoCache
      let dir = remoteRepoCacheDir cache repoId </> subDir
          (RemoteRepo repoId _ _ _ _) = repo
      files <- findGlob dir
      return (Remote repoId, files)
    findGlob :: FilePath -> Eff e [FilePath]
    findGlob dir = do
      traceL (printf "reading contents of directory '%s'" dir)
      ensureDir (dir ++ "/")
      files <- liftIO (getDirectoryContents dir)
      return ((dir </>) <$> filter (matchGlob glob) files)

-- | Push a file from the cache to a remote repository
pushToRepo :: (CommandIO e) => RemoteRepo -> FilePath -> FilePath -> Eff e ()
pushToRepo repo@(RemoteRepo repoId _ _ _ _) src dest = do
  dbgL (printf "PUSHING '%s' TO REPO '%s'" (takeFileName src) repoId)
  cmd (repoEnsureDirCmd repo dest)
  cmd (pushCmd repo src dest)

-- | Pull a file from a remote repository to cache
pullFromRepo ::  (CommandIO e) => RemoteRepo -> FilePath -> FilePath -> Eff e ()
pullFromRepo repo@(RemoteRepo repoId rootDir _key (SshRemoteHost (host, _port)) (SshRemoteUser user)) src dest = do
  dbgL (printf "PULLING '%s' FROM REPO '%s'" (takeFileName src) repoId)
  cmd (printf "rsync -rtv -e 'ssh %s' '%s@%s:%s' '%s'" (sshOpts repo) user host (rootDir </> src) dest)

-- | Push a file from the cache to a remote repository
pullGlob ::  (CommandIO e, Member RepoCacheReader e) => FilePath -> FilePathGlob -> RemoteRepo -> Eff e ()
pullGlob subDir glob repo@(RemoteRepo repoId rootDir _key (SshRemoteHost (host, _port)) (SshRemoteUser user)) = do
  cache <- getRepoCache
  infoL (printf "SYNCING REPO METADATA '%s'" repoId)
  let c =
        printf
          "rsync -rtv --include '%s' --exclude '*.*' -e 'ssh %s' '%s@%s:%s/' '%s/'"
          (globToPattern glob)
          (sshOpts repo)
          user
          host
          (rootDir </> subDir)
          destDir
      destDir = repoCacheDir </> subDir
      repoCacheDir = remoteRepoCacheDir cache repoId
  ensureDir destDir
  cmd c

-- | Express a pattern for file paths, used when searching repositories.
newtype FilePathGlob =
  FileExtension String

-- * Internals
globToPattern :: FilePathGlob -> String
globToPattern (FileExtension ext) = "*." ++ ext

-- | A predicate that is satisfied if a file path matches a glob.
matchGlob :: FilePathGlob -> FilePath -> Bool
matchGlob (FileExtension ext) = isSuffixOf ("." ++ ext)

-- | A shell command string for invoking rsync to push a path to a remote host
-- via ssh.
pushCmd :: RemoteRepo -> FilePath -> FilePath -> String
pushCmd repo@(RemoteRepo _repoId rootDir _key (SshRemoteHost (host, _port)) (SshRemoteUser user)) src dest =
  printf "rsync -rtv --inplace --ignore-existing -e 'ssh %s' '%s' '%s'" (sshOpts repo) src sshDest
  where
    sshDest = printf "%s@%s:%s/%s" user host rootDir dest :: String

-- | A shell command string for invoking rsync to create the directories for a
-- file push.
repoEnsureDirCmd :: RemoteRepo -> FilePath -> String
repoEnsureDirCmd repo@(RemoteRepo _repoId rootDir _key (SshRemoteHost (host, _port)) (SshRemoteUser user)) dest =
  printf "ssh %s %s@%s mkdir -p '%s'" (sshOpts repo) user host (rootDir </> takeDirectory dest)

sshOpts :: RemoteRepo -> String
sshOpts (RemoteRepo _repoId _rootDir (SshPrivKey key) (SshRemoteHost (_host, port)) _user) =
  unwords
    [ "-o"
    , "StrictHostKeyChecking=no"
    , "-o"
    , "UserKnownHostsFile=/dev/null"
    , "-o"
    , printf "Port=%i" port
    , "-o"
    , "IdentityFile=" ++ key
    ]