Expect JSON instead of Text

cabal.project

+packages: .
+
+source-repository-package
+  type: git
+  location: https://github.com/haskell-servant/servant.git
+  tag: 27173c922311112dd153346cf3cd72b9fb0f3551
+  subdir: servant servant-server
\ No newline at end of file

default.nix

-{ mkDerivation, base, bytestring, mtl, optparse-applicative
-, optparse-generic, servant, servant-server, shelly, stdenv, text
-, warp, zlib
+{ mkDerivation, aeson, base, bytestring, directory, mtl
+, optparse-applicative, optparse-generic, servant, servant-server
+, shelly, stdenv, text, warp, zlib
 }:
 mkDerivation {
   pname = "terraform-http-backend-pass";
@@ -9,8 +9,8 @@ mkDerivation {
   isLibrary = true;
   isExecutable = true;
   libraryHaskellDepends = [
-    base bytestring mtl optparse-applicative optparse-generic servant
-    servant-server shelly text warp
+    aeson base bytestring directory mtl optparse-applicative
+    optparse-generic servant servant-server shelly text warp
   ];
   librarySystemDepends = [ zlib ];
   executableHaskellDepends = [ base ];

shell.nix

@@ -4,17 +4,19 @@ let
 
   inherit (nixpkgs) pkgs;
 
-  f = { mkDerivation, base, servant, servant-server, shelly, stdenv
-      , text, zlib
+  f = { mkDerivation, aeson, base, bytestring, directory, mtl
+      , optparse-applicative, optparse-generic, servant, servant-server
+      , shelly, stdenv, text, warp, zlib
       }:
       mkDerivation {
-        pname = "terraform-http-pass-backend";
+        pname = "terraform-http-backend-pass";
         version = "0.1.0.0";
         src = ./.;
         isLibrary = true;
         isExecutable = true;
         libraryHaskellDepends = [
-          base servant servant-server shelly text
+          aeson base bytestring directory mtl optparse-applicative
+          optparse-generic servant servant-server shelly text warp
         ];
         librarySystemDepends = [ zlib ];
         executableHaskellDepends = [ base ];

src/Terraform/HttpBackend/Pass/Api.hs

 {-# 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)
@@ -16,9 +24,31 @@ import Terraform.HttpBackend.Pass.App (AppT)
 import Terraform.HttpBackend.Pass.Crypt (MonadPass (..))
 import Terraform.HttpBackend.Pass.Git (MonadGit (..))
 
-type GetState = "state" :> Capture "name" Text :> UVerb 'GET '[PlainText] [WithStatus 200 Text, WithStatus 404 Text]
+data StateNotFound = StateNotFound
 
-type UpdateState = "state" :> Capture "name" Text :> ReqBody '[PlainText] Text :> PostNoContent
+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
 
@@ -33,21 +63,27 @@ server =
     :<|> updateStateImpl
     :<|> purgeStateImpl
 
-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 (Union GetResponse)
 getStateImpl name = do
   gitPull
   let path = stateFilePath name
   stateExists <- exists path
   if stateExists
-    then respond =<< (WithStatus @200 <$> decrypt path)
-    else respond (WithStatus @404 ("Not found!" :: Text))
+    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 -> Text -> m NoContent
+updateStateImpl :: (Monad m, MonadPass m, MonadGit m) => Text -> Value -> m NoContent
 updateStateImpl name tfstate = do
   gitPull
   let path = stateFilePath name
   -- Also commits
-  encrypt path tfstate
+  encrypt path $ LText.toStrict $ Aeson.encodeToLazyText tfstate
 
   gitPush
   pure NoContent

src/Terraform/HttpBackend/Pass/Run.hs

@@ -2,6 +2,7 @@
 
 module Terraform.HttpBackend.Pass.Run where
 
+import Data.Function ((&))
 import qualified Network.Wai.Handler.Warp as Warp
 import Options.Generic
 import qualified Servant.Server as Servant

terraform-http-backend-pass.cabal

@@ -19,6 +19,7 @@ library
   default-language:    Haskell2010
   extra-libraries:     z
   build-depends:       base >= 4.14 && <5
+                     , aeson
                      , bytestring
                      , directory
                      , mtl