content: {-# LANGUAGE DeriveGeneric #-}
  {-# LANGUAGE DuplicateRecordFields #-}
  
  module Glot.DockerRun
      ( RunRequest(..)
      , RunRequestPayload(..)
      , RunResult(..)
      , Config(..)
      , run
      , Error(..)
      , ErrorBody(..)
      , formatError
      , debugError
      ) where
  
  import Import hiding (RunResult)
  import qualified Data.List.NonEmpty as NonEmpty
  import qualified GHC.Generics as GHC
  import qualified Data.Aeson as Aeson
  import qualified Network.HTTP.Req as Req
  import qualified Glot.Snippet as Snippet
  import qualified Control.Exception as Exception
  import qualified Data.Bifunctor as Bifunctor
  import qualified Network.HTTP.Client as Http
  import qualified Network.HTTP.Types.Status as Status
  import qualified Text.URI as URI
  import qualified Glot.Language as Language
  
  import Data.Function ((&))
  
  
  data RunRequest = RunRequest
      { image :: Text
      , payload :: RunRequestPayload
      }
      deriving (Show, GHC.Generic)
  
  instance Aeson.ToJSON RunRequest
  
  
  data RunRequestPayload = RunRequestPayload
      { language :: Language.Id
      , files :: NonEmpty.NonEmpty Snippet.FilePayload
      , stdin :: Maybe Text
      , command :: Maybe Text
      }
      deriving (Show, GHC.Generic)
  
  instance Aeson.ToJSON RunRequestPayload
  
  
  data RunResult = RunResult
      { stdout :: Text
      , stderr :: Text
      , error :: Text
      }
      deriving (Show, GHC.Generic)
  
  instance Aeson.FromJSON RunResult
  instance Aeson.ToJSON RunResult
  
  
  data Config = Config
      { accessToken :: ByteString
      , baseUrl :: Text
      , responseTimeout :: Int
      }
  
  
  run :: Config -> RunRequest -> IO (Either Error RunResult)
  run Config{..} runRequest =
      let
          reqConfig =
              Req.defaultHttpConfig
                  { Req.httpConfigRedirectCount = 0
                  , Req.httpConfigCheckResponse = \_ _ _ -> Nothing
                  , Req.httpConfigRetryJudge = \_ _ -> False
                  , Req.httpConfigRetryJudgeException = \_ _ -> False
                  }
  
          mkOptions :: Req.Option scheme -> Req.Option scheme
          mkOptions urlOptions =
              urlOptions
                  <> Req.header "X-Access-Token" accessToken
                  <> Req.responseTimeout (responseTimeout * 1000000)
  
          runReq httpOrHttpsUrl = do
              res <- Req.runReq reqConfig $ do
                  case httpOrHttpsUrl of
                      Left (httpUrl, urlOptions) ->
                          Req.req Req.POST httpUrl (Req.ReqBodyJson runRequest) Req.bsResponse (mkOptions urlOptions)
  
                      Right (httpsUrl, urlOptions) ->
                          Req.req Req.POST httpsUrl (Req.ReqBodyJson runRequest) Req.bsResponse (mkOptions urlOptions)
              pure (handleResponse res)
      in do
      uri <- URI.mkURI (baseUrl <> "/run")
      case Req.useURI uri of
          Nothing -> do
              pure $ Left ParseUrlError
  
          Just httpOrHttpsUrl -> do
              eitherResult <- Exception.try (runReq httpOrHttpsUrl)
              case eitherResult of
                  Left exception ->
                      pure (Left $ HttpException exception)
  
                  Right e ->
                      pure e
  
  
  handleResponse :: (Req.HttpResponse response, Req.HttpResponseBody response ~ ByteString) => response -> Either Error RunResult
  handleResponse res =
      let
          body =
              Req.responseBody res
      in
      if isSuccessStatus (Req.responseStatusCode res) then
          Aeson.eitherDecodeStrict' body
              & Bifunctor.first (DecodeSuccessResponseError body)
  
        else
          case Aeson.eitherDecodeStrict' body of
              Right apiError ->
                  Left (ApiError apiError)
  
              Left decodeError ->
                  Left (DecodeErrorResponseError body decodeError)
  
  
  
  isSuccessStatus :: Int -> Bool
  isSuccessStatus code =
      code >= 200 && code <= 299
  
  
  data Error
      = ParseUrlError
      | HttpException Req.HttpException
      | DecodeSuccessResponseError ByteString String
      | DecodeErrorResponseError ByteString String
      | ApiError ErrorBody
  
  
  debugError :: Error -> String
  debugError err =
      case err of
          ParseUrlError ->
              "ParseUrlError"
  
          HttpException exception ->
              "HttpException: " <> (show exception)
  
          DecodeSuccessResponseError body reason ->
              "DecodeSuccessResponseError: " <> (show reason) <> ", body: " <> (show body)
  
          DecodeErrorResponseError body reason ->
              "DecodeErrorResponseError: " <> (show reason) <> ", body: " <> (show body)
  
          ApiError errorBody ->
              "ApiError: " <> (show errorBody)
  
  
  formatError :: Error -> String
  formatError err =
      case err of
          ParseUrlError ->
              "Invalid docker-run url"
  
          HttpException exception ->
              case exception of
                  Req.JsonHttpException reason ->
                      "Failed to decode json response from docker-run: " <> reason
  
                  Req.VanillaHttpException httpException ->
                      case httpException of
                          InvalidUrlException url reason ->
                              "Invalid request url: " <> url <> " (" <> reason <> ")"
  
                          HttpExceptionRequest _ exceptionContent ->
                              case exceptionContent of
                                  Http.StatusCodeException response _ ->
                                      "Unexpected status code in response from docker-run: " <> (show $ Status.statusCode $ Http.responseStatus response)
  
                                  Http.TooManyRedirects _ ->
                                      "Too many redirect"
  
                                  Http.OverlongHeaders ->
                                      "Header overflow from docker-run"
  
                                  Http.ResponseTimeout ->
                                      "docker-run took too long to return a response"
  
                                  Http.ConnectionTimeout ->
                                      "Attempting to connect to docker-run timed out"
  
                                  Http.ConnectionFailure _ ->
                                      "An exception occurred when trying to connect to docker-run"
  
                                  Http.InvalidStatusLine _ ->
                                      "The status line returned by docker-run could not be parsed"
  
                                  Http.InvalidHeader _ ->
                                      "The given response header line from docker-run could not be parsed"
  
                                  Http.InvalidRequestHeader _ ->
                                      "The given request header is not compliant"
  
                                  Http.InternalException _ ->
                                      "An exception was raised by an underlying library when performing the request"
  
                                  Http.ProxyConnectException _ _ _ ->
                                      "A non-200 status code was returned when trying to connect to the proxy server on the given host and port"
  
                                  Http.NoResponseDataReceived ->
                                      "No response data was received from the docker-run at all"
  
                                  Http.TlsNotSupported ->
                                      "Tls not supported"
  
                                  Http.WrongRequestBodyStreamSize _ _ ->
                                      "The request body provided did not match the expected size."
  
                                  Http.ResponseBodyTooShort _ _ ->
                                      "The returned response body from docker-run is too short"
  
                                  Http.InvalidChunkHeaders ->
                                      "A chunked response body had invalid headers"
  
                                  Http.IncompleteHeaders ->
                                      "An incomplete set of response headers were returned from docker-run"
  
                                  Http.InvalidDestinationHost _ ->
                                      "The host we tried to connect to is invalid"
  
                                  Http.HttpZlibException _ ->
                                      "An exception was thrown when inflating the response body from docker-run"
  
                                  Http.InvalidProxyEnvironmentVariable _ _ ->
                                      "Values in the proxy environment variable were invalid"
  
                                  Http.ConnectionClosed ->
                                      "Attempted to use a Connection which was already closed"
  
                                  Http.InvalidProxySettings _ ->
                                      "Proxy settings are not valid"
  
  
          DecodeSuccessResponseError _ decodeError ->
              show decodeError
  
          DecodeErrorResponseError _ decodeError ->
              show decodeError
  
          ApiError errorBody ->
              show errorBody
  
  
  
  data ErrorBody = ErrorBody
      { error :: Text
      , message :: Text
      }
      deriving (Show, GHC.Generic)
  
  instance Aeson.ToJSON ErrorBody
  instance Aeson.FromJSON ErrorBody
  