Skip to content
Snippets Groups Projects
Commit 883e9022 authored by Akshay Mankar's avatar Akshay Mankar
Browse files

Gracefully handle absence of state

parent 9191a56d
No related branches found
No related tags found
No related merge requests found
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
module Terraform.HttpBackend.Pass.Api where module Terraform.HttpBackend.Pass.Api where
import Control.Monad (unless)
import Data.Proxy (Proxy (..)) import Data.Proxy (Proxy (..))
import Data.Text (Text) import Data.Text (Text)
import GHC.Generics (Generic) import GHC.Generics (Generic)
...@@ -14,11 +16,11 @@ import Terraform.HttpBackend.Pass.App (AppT) ...@@ -14,11 +16,11 @@ import Terraform.HttpBackend.Pass.App (AppT)
import Terraform.HttpBackend.Pass.Crypt (MonadPass (..)) import Terraform.HttpBackend.Pass.Crypt (MonadPass (..))
import Terraform.HttpBackend.Pass.Git (MonadGit (..)) import Terraform.HttpBackend.Pass.Git (MonadGit (..))
type GetState = "state" :> Capture "name" Text :> Get '[PlainText] Text type GetState = "state" :> Capture "name" Text :> UVerb 'GET '[PlainText] [WithStatus 200 Text, WithStatus 404 Text]
type UpdateState = "state" :> Capture "name" Text :> ReqBody '[PlainText] Text :> PostNoContent type UpdateState = "state" :> Capture "name" Text :> ReqBody '[PlainText] Text :> PostNoContent
type DeleteState = "state" :> Capture "name" Text :> Delete '[PlainText] Text type DeleteState = "state" :> Capture "name" Text :> DeleteNoContent
type Api = GetState :<|> UpdateState :<|> DeleteState type Api = GetState :<|> UpdateState :<|> DeleteState
...@@ -31,11 +33,14 @@ server = ...@@ -31,11 +33,14 @@ server =
:<|> updateStateImpl :<|> updateStateImpl
:<|> purgeStateImpl :<|> purgeStateImpl
-- TODO: Gracefully return 404 when the file doesn't exist getStateImpl :: (Monad m, MonadGit m, MonadPass m) => Text -> m (Union '[WithStatus 200 Text, WithStatus 404 Text])
getStateImpl :: (Monad m, MonadGit m, MonadPass m) => Text -> m Text
getStateImpl name = do getStateImpl name = do
gitPull gitPull
decrypt (name <> "/terraform.tfstate") let path = stateFilePath name
stateExists <- exists path
if stateExists
then respond =<< (WithStatus @200 <$> decrypt path)
else respond (WithStatus @404 ("Not found!" :: Text))
updateStateImpl :: (Monad m, MonadPass m, MonadGit m) => Text -> Text -> m NoContent updateStateImpl :: (Monad m, MonadPass m, MonadGit m) => Text -> Text -> m NoContent
updateStateImpl name tfstate = do updateStateImpl name tfstate = do
...@@ -47,12 +52,15 @@ updateStateImpl name tfstate = do ...@@ -47,12 +52,15 @@ updateStateImpl name tfstate = do
gitPush gitPush
pure NoContent pure NoContent
purgeStateImpl :: (MonadGit m, MonadPass m, Monad m) => Text -> m Text purgeStateImpl :: (MonadGit m, MonadPass m, Monad m) => Text -> m NoContent
purgeStateImpl name = do purgeStateImpl name = do
tfstate <- getStateImpl name gitPull
purge $ stateFilePath name let path = stateFilePath name
gitPush stateExists <- exists path
pure tfstate unless stateExists $ do
purge (stateFilePath name)
gitPush
pure NoContent
stateFilePath :: Text -> Text stateFilePath :: Text -> Text
stateFilePath name = name <> "/terraform.tfstate" stateFilePath name = name <> "/terraform.tfstate"
...@@ -6,12 +6,13 @@ ...@@ -6,12 +6,13 @@
module Terraform.HttpBackend.Pass.App where module Terraform.HttpBackend.Pass.App where
import Control.Monad.IO.Class (MonadIO) import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Reader (MonadReader (ask), ReaderT (runReaderT)) import Control.Monad.Reader (MonadReader (ask), ReaderT (runReaderT))
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as Text import qualified Data.Text as Text
import Shelly (shelly) import Shelly (shelly)
import qualified Shelly import qualified Shelly
import System.Directory (doesFileExist)
import Terraform.HttpBackend.Pass.Crypt (MonadPass (..)) import Terraform.HttpBackend.Pass.Crypt (MonadPass (..))
import Terraform.HttpBackend.Pass.Env (Env (..)) import Terraform.HttpBackend.Pass.Env (Env (..))
import Terraform.HttpBackend.Pass.Git (MonadGit (..)) import Terraform.HttpBackend.Pass.Git (MonadGit (..))
...@@ -48,6 +49,9 @@ instance (Monad m, MonadIO m) => MonadPass (AppT m) where ...@@ -48,6 +49,9 @@ instance (Monad m, MonadIO m) => MonadPass (AppT m) where
shelly $ do shelly $ do
Shelly.setenv "PASSWORD_STORE_DIR" (Text.pack directory) Shelly.setenv "PASSWORD_STORE_DIR" (Text.pack directory)
Shelly.run_ "pass" ["rm", name] Shelly.run_ "pass" ["rm", name]
exists name = do
Env {..} <- ask
liftIO $ doesFileExist (directory <> "/" <> Text.unpack name)
runAppT :: Env -> AppT m a -> m a runAppT :: Env -> AppT m a -> m a
runAppT env (AppT r) = runReaderT r env runAppT env (AppT r) = runReaderT r env
...@@ -6,3 +6,4 @@ class MonadPass m where ...@@ -6,3 +6,4 @@ class MonadPass m where
encrypt :: Text -> Text -> m () encrypt :: Text -> Text -> m ()
decrypt :: Text -> m Text decrypt :: Text -> m Text
purge :: Text -> m () purge :: Text -> m ()
exists :: Text -> m Bool
...@@ -20,6 +20,7 @@ library ...@@ -20,6 +20,7 @@ library
extra-libraries: z extra-libraries: z
build-depends: base >= 4.14 && <5 build-depends: base >= 4.14 && <5
, bytestring , bytestring
, directory
, mtl , mtl
, optparse-applicative , optparse-applicative
, optparse-generic , optparse-generic
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment