{-# 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 :: StateNotFound -> Value
toJSON StateNotFound
_ = [Pair] -> Value
Aeson.object [Key
"error" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"state not found" :: Text)]

newtype StateCorrupt = StateCorrupt {StateCorrupt -> String
err :: String}

instance HasStatus StateCorrupt where
  type StatusOf StateCorrupt = 500

instance ToJSON StateCorrupt where
  toJSON :: StateCorrupt -> Value
toJSON (StateCorrupt String
err) =
    [Pair] -> Value
Aeson.object
      [ Key
"error" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"state corrupt" :: Text),
        Key
"message" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
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 Api
api = forall {k} (t :: k). Proxy t
Proxy

server :: (Monad m, MonadPass m, MonadGit m) => ServerT Api m
server :: forall (m :: * -> *).
(Monad m, MonadPass m, MonadGit m) =>
ServerT Api m
server =
  forall (m :: * -> *).
(Monad m, MonadGit m, MonadPass m) =>
Text -> m (Union GetResponse)
getStateImpl
    forall a b. a -> b -> a :<|> b
:<|> forall (m :: * -> *).
(Monad m, MonadPass m, MonadGit m) =>
Text -> Value -> m NoContent
updateStateImpl
    forall a b. a -> b -> a :<|> b
:<|> forall (m :: * -> *).
(MonadGit m, MonadPass m, Monad m) =>
Text -> m NoContent
purgeStateImpl

getStateImpl :: (Monad m, MonadGit m, MonadPass m) => Text -> m (Union GetResponse)
getStateImpl :: forall (m :: * -> *).
(Monad m, MonadGit m, MonadPass m) =>
Text -> m (Union GetResponse)
getStateImpl Text
name = do
  forall (m :: * -> *). MonadGit m => m ()
gitPull
  let path :: Text
path = Text -> Text
stateFilePath Text
name
  Bool
stateExists <- forall (m :: * -> *). MonadPass m => Text -> m Bool
exists Text
path
  if Bool
stateExists
    then do
      Either String Value
eitherState <-
        forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode @Value forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.fromStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadPass m => Text -> m Text
decrypt Text
path
      case Either String Value
eitherState of
        Left String
err -> forall x (xs :: [*]) (f :: * -> *).
(Applicative f, HasStatus x, IsMember x xs) =>
x -> f (Union xs)
respond forall a b. (a -> b) -> a -> b
$ String -> StateCorrupt
StateCorrupt String
err
        Right Value
state -> forall x (xs :: [*]) (f :: * -> *).
(Applicative f, HasStatus x, IsMember x xs) =>
x -> f (Union xs)
respond (forall (k :: Nat) a. a -> WithStatus k a
WithStatus @200 Value
state)
    else forall x (xs :: [*]) (f :: * -> *).
(Applicative f, HasStatus x, IsMember x xs) =>
x -> f (Union xs)
respond StateNotFound
StateNotFound

updateStateImpl :: (Monad m, MonadPass m, MonadGit m) => Text -> Value -> m NoContent
updateStateImpl :: forall (m :: * -> *).
(Monad m, MonadPass m, MonadGit m) =>
Text -> Value -> m NoContent
updateStateImpl Text
name Value
tfstate = do
  forall (m :: * -> *). MonadGit m => m ()
gitPull
  let path :: Text
path = Text -> Text
stateFilePath Text
name
  -- Also commits
  forall (m :: * -> *). MonadPass m => Text -> Text -> m ()
encrypt Text
path forall a b. (a -> b) -> a -> b
$ Text -> Text
LText.toStrict forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Text
Aeson.encodeToLazyText Value
tfstate

  forall (m :: * -> *). MonadGit m => m ()
gitPush
  forall (f :: * -> *) a. Applicative f => a -> f a
pure NoContent
NoContent

purgeStateImpl :: (MonadGit m, MonadPass m, Monad m) => Text -> m NoContent
purgeStateImpl :: forall (m :: * -> *).
(MonadGit m, MonadPass m, Monad m) =>
Text -> m NoContent
purgeStateImpl Text
name = do
  forall (m :: * -> *). MonadGit m => m ()
gitPull
  let path :: Text
path = Text -> Text
stateFilePath Text
name
  Bool
stateExists <- forall (m :: * -> *). MonadPass m => Text -> m Bool
exists Text
path
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
stateExists forall a b. (a -> b) -> a -> b
$ do
    forall (m :: * -> *). MonadPass m => Text -> m ()
purge (Text -> Text
stateFilePath Text
name)
    forall (m :: * -> *). MonadGit m => m ()
gitPush
  forall (f :: * -> *) a. Applicative f => a -> f a
pure NoContent
NoContent

stateFilePath :: Text -> Text
stateFilePath :: Text -> Text
stateFilePath Text
name = Text
name forall a. Semigroup a => a -> a -> a
<> Text
"/terraform.tfstate"