diff --git a/elm.json b/elm.json index adc5c75..9c913fc 100644 --- a/elm.json +++ b/elm.json @@ -13,11 +13,11 @@ "elm-version": "0.19.0 <= v < 0.20.0", "dependencies": { "elm/core": "1.0.0 <= v < 2.0.0", - "elm/http": "1.0.0 <= v < 2.0.0", + "elm/http": "2.0.0 <= v < 3.0.0", "elm/json": "1.0.0 <= v < 2.0.0", "elm/url": "1.0.0 <= v < 2.0.0" }, "test-dependencies": { "elm-explorations/test": "1.0.0 <= v < 2.0.0" } -} \ No newline at end of file +} diff --git a/example/Main.elm b/example/Main.elm index a1338a3..d33a2f7 100644 --- a/example/Main.elm +++ b/example/Main.elm @@ -1,11 +1,11 @@ module Main exposing (..) +import Browser import GraphQL.Client.Http as GraphQLClient import GraphQL.Request.Builder exposing (..) import GraphQL.Request.Builder.Arg as Arg import GraphQL.Request.Builder.Variable as Var -import Html exposing (Html, div, text) -import Task exposing (Task) +import Html exposing (Html) {-| Responses to `starWarsRequest` are decoded into this type. @@ -30,7 +30,6 @@ fragment filmPlanetsFragment on Film { } } } - query ($filmID: ID!, $pageSize: Int = 3) { film(filmID: $filmID) { title @@ -106,55 +105,95 @@ connectionNodes spec = ) -type alias StarWarsResponse = - Result GraphQLClient.Error FilmSummary - - type alias Model = - Maybe StarWarsResponse + Maybe FilmSummary type Msg - = ReceiveQueryResponse StarWarsResponse + = ReceiveQueryResponse FilmSummary + | ReceiveQueryError -sendQueryRequest : Request Query a -> Task GraphQLClient.Error a -sendQueryRequest request = - GraphQLClient.sendQuery "/" request +graphQLToMsg : GraphQLClient.Result FilmSummary -> Msg +graphQLToMsg result = + case result of + GraphQLClient.GraphQLSucces data -> + ReceiveQueryResponse data + -- Explicitly ignoring GraphQL data + GraphQLClient.GraphQLErrors _ _ -> + ReceiveQueryError -sendStarWarsQuery : Cmd Msg -sendStarWarsQuery = - sendQueryRequest starWarsRequest - |> Task.attempt ReceiveQueryResponse + GraphQLClient.HttpError _ -> + ReceiveQueryError -main : Program Never Model Msg +sendQueryRequest : Request Query FilmSummary -> Cmd Msg +sendQueryRequest request = + GraphQLClient.sendQuery "/" graphQLToMsg request + + +main : Program () Model Msg main = - Html.program + Browser.document { init = init , view = view , update = update - , subscriptions = subscriptions + , subscriptions = \_ -> Sub.none } -init : ( Model, Cmd Msg ) -init = - ( Nothing, sendStarWarsQuery ) +init : () -> ( Model, Cmd Msg ) +init () = + ( Nothing, sendQueryRequest starWarsRequest ) -view : Model -> Html Msg +view : Model -> Browser.Document Msg view model = - div [] - [ model |> toString |> text ] + { title = "Example" + , body = + [ Maybe.map viewFilmSummary model |> Maybe.withDefault (Html.text "Nothing") ] + } -update : Msg -> Model -> ( Model, Cmd Msg ) -update (ReceiveQueryResponse response) model = - ( Just response, Cmd.none ) +viewFilmSummary : FilmSummary -> Html Msg +viewFilmSummary summary = + Html.div [] + [ Html.text ("Title: " ++ Maybe.withDefault "Unknown" summary.title) + , viewCharacterNames summary.someCharacterNames + , viewPlanetNames <| Maybe.withDefault [] summary.somePlanetNames + ] -subscriptions : Model -> Sub Msg -subscriptions model = - Sub.none +viewCharacterNames : List (Maybe String) -> Html Msg +viewCharacterNames names = + Html.div [] + [ Html.text "Character names: " + , viewNameList names + ] + + +viewPlanetNames : List (Maybe String) -> Html Msg +viewPlanetNames names = + Html.div [] + [ Html.text "Planet names: " + , viewNameList names + ] + + +viewNameList : List (Maybe String) -> Html Msg +viewNameList names = + names + |> List.map (Maybe.withDefault " -- ") + |> String.join ", " + |> Html.text + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case msg of + ReceiveQueryResponse data -> + ( Just data, Cmd.none ) + + ReceiveQueryError -> + ( Nothing, Cmd.none ) diff --git a/example/elm-package.json b/example/elm-package.json deleted file mode 100644 index f44c0a7..0000000 --- a/example/elm-package.json +++ /dev/null @@ -1,17 +0,0 @@ -{ - "version": "1.0.0", - "summary": "Example of using elm-graphql", - "repository": "https://github.com/jamesmacaulay/elm-graphql.git", - "license": "BSD3", - "source-directories": [ - ".", - "../src" - ], - "exposed-modules": [], - "dependencies": { - "elm-lang/core": "5.0.0 <= v < 6.0.0", - "elm-lang/html": "2.0.0 <= v < 3.0.0", - "elm-lang/http": "1.0.0 <= v < 2.0.0" - }, - "elm-version": "0.18.0 <= v < 0.19.0" -} diff --git a/example/elm.json b/example/elm.json new file mode 100644 index 0000000..a3f0425 --- /dev/null +++ b/example/elm.json @@ -0,0 +1,28 @@ +{ + "type": "application", + "source-directories": [ + ".", + "../src" + ], + "elm-version": "0.19.1", + "dependencies": { + "direct": { + "elm/browser": "1.0.2", + "elm/core": "1.0.5", + "elm/html": "1.0.0", + "elm/http": "1.0.0", + "elm/json": "1.1.3", + "elm/url": "1.0.0" + }, + "indirect": { + "elm/bytes": "1.0.8", + "elm/file": "1.0.5", + "elm/time": "1.0.0", + "elm/virtual-dom": "1.0.2" + } + }, + "test-dependencies": { + "direct": {}, + "indirect": {} + } +} diff --git a/src/GraphQL/Client/Http.elm b/src/GraphQL/Client/Http.elm index 87e7141..e73d497 100644 --- a/src/GraphQL/Client/Http.elm +++ b/src/GraphQL/Client/Http.elm @@ -1,4 +1,7 @@ -module GraphQL.Client.Http exposing (Error(..), RequestError, DocumentLocation, sendQuery, sendMutation, RequestOptions, customSendQuery, customSendMutation, customSendQueryRaw, customSendMutationRaw) +module GraphQL.Client.Http exposing + ( RequestError, DocumentLocation, sendQuery, sendMutation, RequestOptions, customSendQuery, customSendMutation + , Result(..), graphQLValue + ) {-| The functions in this module let you perform HTTP requests to conventional GraphQL server endpoints. @@ -8,8 +11,75 @@ module GraphQL.Client.Http exposing (Error(..), RequestError, DocumentLocation, import GraphQL.Client.Http.Util as Util import GraphQL.Request.Builder as Builder +import GraphQL.Response import Http -import Task exposing (Task) +import Json.Decode as Decode exposing (Decoder) +import Json.Encode as Encode + + +graphQLBodyWith : List ( String, Encode.Value ) -> Builder.Request operationType result -> Http.Body +graphQLBodyWith extraFields request = + let + documentString = + Builder.requestBody request + + variableValues = + Builder.jsonVariableValues request + + postBody = + Util.postBodyJsonWith extraFields documentString variableValues + in + Http.stringBody "application/json" <| Encode.encode 0 postBody + + +graphQLBody : Builder.Request operationType result -> Http.Body +graphQLBody = + graphQLBodyWith [] + + +graphQLValue : Builder.Request operationType result -> { query : String, variables : Maybe Encode.Value } +graphQLValue request = + { query = Builder.requestBody request, variables = Builder.jsonVariableValues request } + + +createResult : data -> List RequestError -> Result data +createResult data errors = + case errors of + [] -> + GraphQLSucces data + + _ -> + GraphQLErrors errors data + + +graphQLErrorsDecoder : Decoder (List RequestError) +graphQLErrorsDecoder = + Decode.oneOf + [ Decode.field "errors" GraphQL.Response.errorsDecoder + , Decode.succeed [] + ] + + +graphQLDecoder : Decoder data -> Decoder (Result data) +graphQLDecoder dataDecoder = + Decode.map2 createResult + (Decode.field "data" dataDecoder) + graphQLErrorsDecoder + + +extractResult : Result.Result Http.Error (Result data) -> Result data +extractResult result = + case result of + Err err -> + HttpError err + + Ok res -> + res + + +graphQLExpect : (Result data -> msg) -> Builder.Request operationType data -> Http.Expect msg +graphQLExpect tagger request = + Http.expectJson (extractResult >> tagger) (graphQLDecoder <| Builder.responseDataDecoder request) {-| An error returned by the GraphQL server that indicates there was something wrong with the request. @@ -30,37 +100,30 @@ type alias DocumentLocation = {-| Represents errors that can occur when sending a GraphQL request over HTTP. -} -type Error - = HttpError Http.Error - | GraphQLError (List RequestError) +type Result data + = GraphQLSucces data + | GraphQLErrors (List RequestError) data + | HttpError Http.Error {-| Takes a URL and a `Query` `Request` and returns a `Task` that you can perform with `Task.attempt` which will send a `POST` request to a GraphQL server at the given endpoint. -} sendQuery : String - -> Builder.Request Builder.Query result - -> Task Error result + -> (Result data -> msg) + -> Builder.Request Builder.Query data + -> Cmd msg sendQuery = Util.defaultRequestOptions >> send -{-| Takes a URL and a `Query` `Request` and returns a `Task` that you can perform with `Task.attempt` which will send a `POST` request to a GraphQL server at the given endpoint and return raw `Http.Response` in Task. --} -sendQueryRaw : - String - -> Builder.Request Builder.Query result - -> Task Error (Http.Response String) -sendQueryRaw = - Util.defaultRequestOptions >> sendExpecting rawExpect - - {-| Takes a URL and a `Mutation` `Request` and returns a `Task` that you can perform with `Task.attempt` which will send a `POST` request to a GraphQL server at the given endpoint. -} sendMutation : String - -> Builder.Request Builder.Mutation result - -> Task Error result + -> (Result data -> msg) + -> Builder.Request Builder.Mutation data + -> Cmd msg sendMutation = Util.defaultRequestOptions >> send @@ -69,10 +132,11 @@ sendMutation = -} sendMutationRaw : String - -> Builder.Request Builder.Mutation result - -> Task Error (Http.Response String) -sendMutationRaw = - Util.defaultRequestOptions >> sendExpecting rawExpect + -> (Result data -> msg) + -> Builder.Request Builder.Mutation data + -> Cmd msg +sendMutationRaw url tagger request = + send (Util.defaultRequestOptions url) tagger request {-| Options available for customizing GraphQL HTTP requests. `method` should be either `"GET"` or `"POST"`. For `GET` requests, the `url` is modified to include extra parameters in the query string for the GraphQL document and variables. Otherwise, the document and variables are included in the HTTP request body. @@ -82,6 +146,7 @@ type alias RequestOptions = , headers : List Http.Header , url : String , timeout : Maybe Float + , tracker : Maybe String , withCredentials : Bool } @@ -90,133 +155,43 @@ type alias RequestOptions = -} customSendQuery : RequestOptions - -> Builder.Request Builder.Query result - -> Task Error result + -> (Result data -> msg) + -> Builder.Request Builder.Query data + -> Cmd msg customSendQuery = send -{-| Like `sendQuery`, but takes an `RequestOptions` value instead of a URL to let you further customize the HTTP request. You will get a plain `Http.Response` as Task result. - -Useful for things like caching, custom errors decoding, etc. - -Example of response decoding: - - let - decoder = - GraphQL.Request.Builder.responseDataDecoder request - |> Json.Decode.field "data" - - options = - { method = "GET" - , headers = [] - , url = "/graphql" - , timeout = Nothing - , withCredentials = False - } - in - request - |> GraphQL.Client.Http.customSendQueryRaw options - |> Task.andThen - (\response -> - case Json.Decode.decodeString decoder response.body of - Err err -> - Task.fail <| GraphQL.Client.Http.HttpError <| Http.BadPayload err response - - Ok decodedValue -> - Task.succeed decodedValue - ) - --} -customSendQueryRaw : - RequestOptions - -> Builder.Request Builder.Query result - -> Task Error (Http.Response String) -customSendQueryRaw = - sendExpecting rawExpect - - {-| Like `sendMutation`, but takes an `RequestOptions` value instead of a URL to let you further customize the HTTP request. -} customSendMutation : RequestOptions - -> Builder.Request Builder.Mutation result - -> Task Error result + -> (Result data -> msg) + -> Builder.Request Builder.Mutation data + -> Cmd msg customSendMutation = send -{-| Like `sendMutation`, but takes an `RequestOptions` value instead of a URL to let you further customize the HTTP request. You will get a plain `Http.Response` as Task result. - -Useful for things like custom errors decoding, etc. - -Example of response decoding: - - let - decoder = - GraphQL.Request.Builder.responseDataDecoder mutationRequest - |> Json.Decode.field "data" - - options = - { method = "GET" - , headers = [] - , url = "/graphql" - , timeout = Nothing - , withCredentials = False - } - in - mutationRequest - |> GraphQL.Client.Http.customSendMutationRaw options - |> Task.andThen - (\response -> - case Json.Decode.decodeString decoder response.body of - Err err -> - Task.fail <| GraphQL.Client.Http.HttpError <| Http.BadPayload err response - - Ok decodedValue -> - Task.succeed decodedValue - ) - --} -customSendMutationRaw : - RequestOptions - -> Builder.Request Builder.Mutation result - -> Task Error (Http.Response String) -customSendMutationRaw = - sendExpecting rawExpect - - -rawExpect : Http.Expect (Http.Response String) -rawExpect = - Http.expectStringResponse Ok - - send : RequestOptions - -> Builder.Request operationType result - -> Task Error result -send options request = + -> (Result data -> msg) + -> Builder.Request operationType data + -> Cmd msg +send options tagger request = let - expect = - Util.defaultExpect (Builder.responseDataDecoder request) + requestArgs = + { method = options.method + , headers = options.headers + , url = options.url + , body = graphQLBody request + , expect = graphQLExpect tagger request + , timeout = options.timeout + , tracker = options.tracker + } in - sendExpecting expect options request - + if options.withCredentials then + Http.riskyRequest requestArgs -sendExpecting : - Http.Expect result - -> RequestOptions - -> Builder.Request operationType result2 - -> Task Error result -sendExpecting expect requestOptions request = - let - documentString = - Builder.requestBody request - - variableValues = - Builder.jsonVariableValues request - in - Util.requestConfig requestOptions documentString expect variableValues - |> Http.request - |> Http.toTask - |> Task.mapError (Util.convertHttpError HttpError GraphQLError) + else + Http.request requestArgs diff --git a/src/GraphQL/Client/Http/Util.elm b/src/GraphQL/Client/Http/Util.elm index ce81a19..b311940 100644 --- a/src/GraphQL/Client/Http/Util.elm +++ b/src/GraphQL/Client/Http/Util.elm @@ -3,30 +3,38 @@ module GraphQL.Client.Http.Util exposing (..) import GraphQL.Response as Response import Http import Json.Decode -import Json.Encode +import Json.Encode as Encode import Url -postBodyJson : String -> Maybe Json.Encode.Value -> Json.Encode.Value -postBodyJson documentString variableValues = +postBodyJsonWith : List ( String, Encode.Value ) -> String -> Maybe Encode.Value -> Encode.Value +postBodyJsonWith extraFields documentString variableValues = let documentValue = - Json.Encode.string documentString + Encode.string documentString extraParams = - variableValues - |> Maybe.map (\obj -> [ ( "variables", obj ) ]) - |> Maybe.withDefault [] + case variableValues of + Just obj -> + ( "variables", obj ) :: extraFields + + Nothing -> + extraFields in - Json.Encode.object ([ ( "query", documentValue ) ] ++ extraParams) + Encode.object <| ( "query", documentValue ) :: extraParams + + +postBodyJson : String -> Maybe Encode.Value -> Encode.Value +postBodyJson = + postBodyJsonWith [] -postBody : String -> Maybe Json.Encode.Value -> Http.Body +postBody : String -> Maybe Encode.Value -> Http.Body postBody documentString variableValues = Http.jsonBody (postBodyJson documentString variableValues) -parameterizedUrl : String -> String -> Maybe Json.Encode.Value -> String +parameterizedUrl : String -> String -> Maybe Encode.Value -> String parameterizedUrl url documentString variableValues = let firstParamPrefix = @@ -43,7 +51,7 @@ parameterizedUrl url documentString variableValues = variableValues |> Maybe.map (\obj -> - "&variables=" ++ Url.percentEncode (Json.Encode.encode 0 obj) + "&variables=" ++ Url.percentEncode (Encode.encode 0 obj) ) |> Maybe.withDefault "" in @@ -55,6 +63,7 @@ type alias RequestOptions = , headers : List Http.Header , url : String , timeout : Maybe Float + , tracker : Maybe String , withCredentials : Bool } @@ -71,11 +80,6 @@ type alias DocumentLocation = } -type Error - = HttpError Http.Error - | GraphQLError (List RequestError) - - type alias RequestConfig a = { method : String , headers : List Http.Header @@ -83,6 +87,7 @@ type alias RequestConfig a = , body : Http.Body , expect : Http.Expect a , timeout : Maybe Float + , tracker : Maybe String , withCredentials : Bool } @@ -93,6 +98,7 @@ defaultRequestOptions url = , headers = [] , url = url , timeout = Nothing + , tracker = Nothing , withCredentials = False } @@ -101,7 +107,7 @@ requestConfig : RequestOptions -> String -> Http.Expect a - -> Maybe Json.Encode.Value + -> Maybe Encode.Value -> RequestConfig a requestConfig requestOptions documentString expect variableValues = let @@ -118,35 +124,6 @@ requestConfig requestOptions documentString expect variableValues = , body = body , expect = expect , timeout = requestOptions.timeout + , tracker = requestOptions.tracker , withCredentials = requestOptions.withCredentials } - - -defaultExpect : Json.Decode.Decoder result -> Http.Expect result -defaultExpect = - Http.expectJson << Json.Decode.field "data" - - -errorsResponseDecoder : Json.Decode.Decoder (List RequestError) -errorsResponseDecoder = - Json.Decode.field "errors" Response.errorsDecoder - - -convertHttpError : (Http.Error -> err) -> (List RequestError -> err) -> Http.Error -> err -convertHttpError wrapHttpError wrapGraphQLError httpError = - let - handleErrorWithResponseBody responseBody = - responseBody - |> Json.Decode.decodeString errorsResponseDecoder - |> Result.map wrapGraphQLError - |> Result.withDefault (wrapHttpError httpError) - in - case httpError of - Http.BadStatus { body } -> - handleErrorWithResponseBody body - - Http.BadPayload _ { body } -> - handleErrorWithResponseBody body - - _ -> - wrapHttpError httpError diff --git a/src/GraphQL/Request.elm b/src/GraphQL/Request.elm deleted file mode 100644 index 21a6526..0000000 --- a/src/GraphQL/Request.elm +++ /dev/null @@ -1,32 +0,0 @@ -module GraphQL.Request exposing - ( Document - , Request - ) - -import GraphQL.Request.Document.AST as AST -import GraphQL.Request.Document.AST.Serialize exposing (serializeDocument) -import Json.Decode exposing (Decoder) - - -type Document - = Document - { ast : AST.Document - , serialized : String - } - - -type Request operations result - = Request - { document : Document - , operationName : Maybe String - , variableValues : List ( String, AST.ConstantValue ) - , decoder : Decoder result - } - - -document : AST.Document -> Document -document ast = - Document - { ast = ast - , serialized = serializeDocument ast - }