{-# LANGUAGE DeriveGeneric #-}
module Net.DigitalOcean.Request (
  -- | * Request wrappers
  get,
  post,
  put,
  delete,

  -- | * Lower level methods
  handleResp,
  url
  ) where

import qualified Data.Text as T
import qualified Network.Wreq as W
import Data.Aeson (FromJSON, parseJSON, Value(..), eitherDecode, ToJSON, toJSON)
import Data.Aeson.Types (parseEither)
import Data.HashMap.Strict as HM (lookup)
import GHC.Generics (Generic)
import Data.ByteString.Lazy (ByteString)
import Control.Lens
import Control.Monad (liftM)
import Control.Monad.Catch (catchAll)
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Error.Class (MonadError(..), Error(..))

import Net.DigitalOcean.Config

data ResponseError = ResponseError
                     { respErr :: String
                     , respDesc :: String
                     } deriving (Show, Eq, Generic)

instance FromJSON ResponseError

baseUrl :: String
baseUrl = "https://api.digitalocean.com"

-- | Get the url for an endpoint
url :: String -> String
url = (++) baseUrl

eitherToME :: (Show t, Error e, MonadError e m) => Either t a -> m a
eitherToME (Left e) = throwError . strMsg . show $ e
eitherToME (Right v) = return v

ensureValidResponse :: (Error e, MonadError e m, MonadIO m) =>
                       W.Response ByteString -> m ()
ensureValidResponse r =
  let sc = r ^. W.responseStatus . W.statusCode
  in if 200 <= sc && sc < 300
     then return ()
     else do
       let mErr :: IO ResponseError
           mErr = (liftM (view W.responseBody) (W.asJSON r))
       err <- liftIO $ catchAll mErr (throwError . strMsg . show)
       throwError . strMsg $ "Err: " ++ respErr err ++ "\nSC: " ++ show sc ++ "\nDesc: " ++
         respDesc err

-- | Given a raw response, extract the json element "key", and then parse.
-- Also error should the status code != 2xx
handleResp :: (FromJSON a, Error e, MonadError e m, MonadIO m) =>
              String -> W.Response ByteString -> m a
handleResp key r = do
  ensureValidResponse r
  ast <- eitherToME . eitherDecode $ r ^. W.responseBody
  case ast of
    Object obj -> case HM.lookup (T.pack key) obj of
      Just v -> eitherToME $ parseEither parseJSON v
      Nothing -> throwError . strMsg $ "No key " ++ key ++ " in response"
    _ -> throwError . strMsg $ "Response was not object"

-- | Send a GET request to the given endpoint, and parse the result via 'handleResp'
get :: (FromJSON a, Error e, MonadError e m, MonadIO m) =>
       String -> String -> Config -> m a
get e k c = liftIO (W.getWith (options c) (url e)) >>=
            handleResp k

-- | Send a POST request to the given endpoint, and parse the result via 'handleResp'
post :: (ToJSON a, FromJSON b, Error e, MonadError e m, MonadIO m) =>
        String -> String -> a -> Config -> m b
post e k b c = liftIO (W.postWith (options c) (url e) (toJSON b)) >>=
               handleResp k

-- | Send a PUT request to the given endpoint, and parse the result via 'handleResp'
put :: (ToJSON a, FromJSON b, Error e, MonadError e m, MonadIO m) =>
       String -> String -> a -> Config -> m b
put e k b c = liftIO (W.putWith (options c) (url e) (toJSON b)) >>=
              handleResp k

-- | Send a DELETE request to the given endpoint, and parse the result via 'handleResp'
delete :: (Error e, MonadError e m, MonadIO m) => String -> Config -> m ()
delete e c = liftIO (W.getWith (options c) (url e)) >>= ensureValidResponse