{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Terraform.HttpBackend.Pass.App where

import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Reader (MonadReader (ask), ReaderT (runReaderT))
import Data.Text (Text)
import qualified Data.Text as Text
import Shelly (shelly)
import qualified Shelly
import System.Directory (doesFileExist)
import Terraform.HttpBackend.Pass.Crypt (MonadPass (..))
import Terraform.HttpBackend.Pass.Env (Env (..))
import Terraform.HttpBackend.Pass.Git (MonadGit (..))

newtype AppT m a = AppT {forall (m :: * -> *) a. AppT m a -> ReaderT Env m a
unAppT :: ReaderT Env m a}
  deriving newtype (forall a b. a -> AppT m b -> AppT m a
forall a b. (a -> b) -> AppT m a -> AppT m b
forall (m :: * -> *) a b. Functor m => a -> AppT m b -> AppT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> AppT m a -> AppT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> AppT m b -> AppT m a
$c<$ :: forall (m :: * -> *) a b. Functor m => a -> AppT m b -> AppT m a
fmap :: forall a b. (a -> b) -> AppT m a -> AppT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> AppT m a -> AppT m b
Functor, forall a. a -> AppT m a
forall a b. AppT m a -> AppT m b -> AppT m a
forall a b. AppT m a -> AppT m b -> AppT m b
forall a b. AppT m (a -> b) -> AppT m a -> AppT m b
forall a b c. (a -> b -> c) -> AppT m a -> AppT m b -> AppT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall {m :: * -> *}. Applicative m => Functor (AppT m)
forall (m :: * -> *) a. Applicative m => a -> AppT m a
forall (m :: * -> *) a b.
Applicative m =>
AppT m a -> AppT m b -> AppT m a
forall (m :: * -> *) a b.
Applicative m =>
AppT m a -> AppT m b -> AppT m b
forall (m :: * -> *) a b.
Applicative m =>
AppT m (a -> b) -> AppT m a -> AppT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> AppT m a -> AppT m b -> AppT m c
<* :: forall a b. AppT m a -> AppT m b -> AppT m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
AppT m a -> AppT m b -> AppT m a
*> :: forall a b. AppT m a -> AppT m b -> AppT m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
AppT m a -> AppT m b -> AppT m b
liftA2 :: forall a b c. (a -> b -> c) -> AppT m a -> AppT m b -> AppT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> AppT m a -> AppT m b -> AppT m c
<*> :: forall a b. AppT m (a -> b) -> AppT m a -> AppT m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
AppT m (a -> b) -> AppT m a -> AppT m b
pure :: forall a. a -> AppT m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> AppT m a
Applicative, forall a. a -> AppT m a
forall a b. AppT m a -> AppT m b -> AppT m b
forall a b. AppT m a -> (a -> AppT m b) -> AppT m b
forall {m :: * -> *}. Monad m => Applicative (AppT m)
forall (m :: * -> *) a. Monad m => a -> AppT m a
forall (m :: * -> *) a b.
Monad m =>
AppT m a -> AppT m b -> AppT m b
forall (m :: * -> *) a b.
Monad m =>
AppT m a -> (a -> AppT m b) -> AppT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> AppT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> AppT m a
>> :: forall a b. AppT m a -> AppT m b -> AppT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
AppT m a -> AppT m b -> AppT m b
>>= :: forall a b. AppT m a -> (a -> AppT m b) -> AppT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
AppT m a -> (a -> AppT m b) -> AppT m b
Monad, MonadReader Env, forall a. IO a -> AppT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall {m :: * -> *}. MonadIO m => Monad (AppT m)
forall (m :: * -> *) a. MonadIO m => IO a -> AppT m a
liftIO :: forall a. IO a -> AppT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> AppT m a
MonadIO)

instance MonadIO m => MonadGit (AppT m) where
  gitAdd :: Text -> AppT m ()
gitAdd Text
path = forall (m :: * -> *).
(MonadIO m, MonadReader Env m) =>
[Text] -> m ()
runGit_ [Text
"add", Text
path]
  gitCommit :: Text -> AppT m ()
gitCommit Text
message = forall (m :: * -> *).
(MonadIO m, MonadReader Env m) =>
[Text] -> m ()
runGit_ [Text
"commit", Text
"-m", Text
message]
  gitPush :: AppT m ()
gitPush = forall (m :: * -> *).
(MonadIO m, MonadReader Env m) =>
[Text] -> m ()
runGit_ [Text
"push"]
  gitPull :: AppT m ()
gitPull = forall (m :: * -> *).
(MonadIO m, MonadReader Env m) =>
[Text] -> m ()
runGit_ [Text
"pull", Text
"--rebase"]
  gitRm :: Text -> AppT m ()
gitRm Text
path = forall (m :: * -> *).
(MonadIO m, MonadReader Env m) =>
[Text] -> m ()
runGit_ [Text
"rm", Text
path]

runGit_ :: (MonadIO m, MonadReader Env m) => [Text] -> m ()
runGit_ :: forall (m :: * -> *).
(MonadIO m, MonadReader Env m) =>
[Text] -> m ()
runGit_ [Text]
args = do
  Env {FilePath
directory :: Env -> FilePath
directory :: FilePath
..} <- forall r (m :: * -> *). MonadReader r m => m r
ask
  forall (m :: * -> *) a. MonadIO m => Sh a -> m a
shelly forall a b. (a -> b) -> a -> b
$ FilePath -> [Text] -> Sh ()
Shelly.run_ FilePath
"git" ([Text
"-C", FilePath -> Text
Text.pack FilePath
directory] forall a. [a] -> [a] -> [a]
++ [Text]
args)

instance (Monad m, MonadIO m) => MonadPass (AppT m) where
  encrypt :: Text -> Text -> AppT m ()
encrypt Text
name Text
secret = do
    Env {FilePath
directory :: FilePath
directory :: Env -> FilePath
..} <- forall r (m :: * -> *). MonadReader r m => m r
ask
    forall (m :: * -> *) a. MonadIO m => Sh a -> m a
shelly forall a b. (a -> b) -> a -> b
$ do
      Text -> Text -> Sh ()
Shelly.setenv Text
"PASSWORD_STORE_DIR" (FilePath -> Text
Text.pack FilePath
directory)
      Text -> Sh ()
Shelly.setStdin Text
secret
      FilePath -> [Text] -> Sh ()
Shelly.run_ FilePath
"pass" [Text
"insert", Text
"-m", Text
name]
  decrypt :: Text -> AppT m Text
decrypt Text
name = do
    Env {FilePath
directory :: FilePath
directory :: Env -> FilePath
..} <- forall r (m :: * -> *). MonadReader r m => m r
ask
    forall (m :: * -> *) a. MonadIO m => Sh a -> m a
shelly forall a b. (a -> b) -> a -> b
$ do
      Text -> Text -> Sh ()
Shelly.setenv Text
"PASSWORD_STORE_DIR" (FilePath -> Text
Text.pack FilePath
directory)
      FilePath -> [Text] -> Sh Text
Shelly.run FilePath
"pass" [Text
name]
  purge :: Text -> AppT m ()
purge Text
name = do
    Env {FilePath
directory :: FilePath
directory :: Env -> FilePath
..} <- forall r (m :: * -> *). MonadReader r m => m r
ask
    forall (m :: * -> *) a. MonadIO m => Sh a -> m a
shelly forall a b. (a -> b) -> a -> b
$ do
      Text -> Text -> Sh ()
Shelly.setenv Text
"PASSWORD_STORE_DIR" (FilePath -> Text
Text.pack FilePath
directory)
      FilePath -> [Text] -> Sh ()
Shelly.run_ FilePath
"pass" [Text
"rm", Text
name]
  exists :: Text -> AppT m Bool
exists Text
name = do
    Env {FilePath
directory :: FilePath
directory :: Env -> FilePath
..} <- forall r (m :: * -> *). MonadReader r m => m r
ask
    let path :: FilePath
path = FilePath
directory forall a. Semigroup a => a -> a -> a
<> FilePath
"/" forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
Text.unpack Text
name forall a. Semigroup a => a -> a -> a
<> FilePath
".gpg"
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
path

runAppT :: Env -> AppT m a -> m a
runAppT :: forall (m :: * -> *) a. Env -> AppT m a -> m a
runAppT Env
env (AppT ReaderT Env m a
r) = forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Env m a
r Env
env