{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module Terraform.HttpBackend.Pass.Api where
import Control.Monad (unless)
import Data.Aeson (ToJSON (..), Value, (.=))
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Text as Aeson
import qualified Data.ByteString.Lazy as LBS
import Data.Proxy (Proxy (..))
import Data.Text (Text)
import qualified Data.Text.Encoding as Text
import qualified Data.Text.Lazy as LText
import GHC.Generics (Generic)
import Servant
import Servant.API.Generic (ToServant, ToServantApi)
import qualified Servant.Server.Generic as Servant
import Terraform.HttpBackend.Pass.App (AppT)
import Terraform.HttpBackend.Pass.Crypt (MonadPass (..))
import Terraform.HttpBackend.Pass.Git (MonadGit (..))
data StateNotFound = StateNotFound
instance HasStatus StateNotFound where
type StatusOf StateNotFound = 404
instance ToJSON StateNotFound where
toJSON _ = Aeson.object ["error" .= ("state not found" :: Text)]
newtype StateCorrupt = StateCorrupt {err :: String}
instance HasStatus StateCorrupt where
type StatusOf StateCorrupt = 500
instance ToJSON StateCorrupt where
toJSON (StateCorrupt err) =
Aeson.object
[ "error" .= ("state corrupt" :: Text),
"message" .= err
]
type GetResponse = '[WithStatus 200 Value, StateNotFound, StateCorrupt]
type GetState = "state" :> Capture "name" Text :> UVerb 'GET '[JSON] GetResponse
type UpdateState = "state" :> Capture "name" Text :> ReqBody '[JSON] Value :> PostNoContent
type DeleteState = "state" :> Capture "name" Text :> DeleteNoContent
type Api = GetState :<|> UpdateState :<|> DeleteState
api :: Proxy Api
api = Proxy
server :: (Monad m, MonadPass m, MonadGit m) => ServerT Api m
server =
getStateImpl
:<|> updateStateImpl
:<|> purgeStateImpl
getStateImpl :: (Monad m, MonadGit m, MonadPass m) => Text -> m (Union GetResponse)
getStateImpl name = do
gitPull
let path = stateFilePath name
stateExists <- exists path
if stateExists
then do
eitherState <-
Aeson.eitherDecode @Value . LBS.fromStrict . Text.encodeUtf8
<$> decrypt path
case eitherState of
Left err -> respond $ StateCorrupt err
Right state -> respond (WithStatus @200 state)
else respond StateNotFound
updateStateImpl :: (Monad m, MonadPass m, MonadGit m) => Text -> Value -> m NoContent
updateStateImpl name tfstate = do
gitPull
let path = stateFilePath name
-- Also commits
encrypt path $ LText.toStrict $ Aeson.encodeToLazyText tfstate
gitPush
pure NoContent
purgeStateImpl :: (MonadGit m, MonadPass m, Monad m) => Text -> m NoContent
purgeStateImpl name = do
gitPull
let path = stateFilePath name
stateExists <- exists path
unless stateExists $ do
purge (stateFilePath name)
gitPush
pure NoContent
stateFilePath :: Text -> Text
stateFilePath name = name <> "/terraform.tfstate"