From fc479767dd4d023f1f5fd3bf2ca8f2624010e3f0 Mon Sep 17 00:00:00 2001 From: Joel Carlbark Date: Thu, 13 Oct 2016 17:05:05 +0200 Subject: [PATCH] Add support for `schemes` in the specification This enables Lagun to understand when to use https. If `schemes` is not present in the specification the protocol of the serving host will be used. --- index.html | 6 +- src/Lagun.elm | 363 +++++++++++++++++++++++++++++--------------------- src/View.elm | 14 +- 3 files changed, 230 insertions(+), 153 deletions(-) diff --git a/index.html b/index.html index 754718a..ff5e1a5 100644 --- a/index.html +++ b/index.html @@ -26,9 +26,13 @@ var param = location.search.substring(1); var item = param.split("="); var specUrl = item[0] == 'spec' ? decodeURIComponent(item[1]) : defaultSpecUrl; + +var a = document.createElement('a'); +a.href = specUrl; +var servingHost = a.protocol + '//' + a.hostname + (a.port ? ':' + a.port : ''); Elm.Main.fullscreen({ specUrl: specUrl, - servingHost: location.hostname+(location.port ? ':' + location.port : '') + servingHost: servingHost }); diff --git a/src/Lagun.elm b/src/Lagun.elm index 45bf0fd..42f3b3d 100644 --- a/src/Lagun.elm +++ b/src/Lagun.elm @@ -12,17 +12,18 @@ import String type alias Model = - { specUrl : String, - spec : Maybe Spec, - expanded : Set String, - paramValues : ParameterValues, - requestResults : RequestResults, - servingHost: String } + { specUrl : String + , spec : Maybe Spec + , expanded : Set String + , paramValues : ParameterValues + , requestResults : RequestResults + , servingHost : String + } -init : { specUrl : String, servingHost: String } -> ( Model, Cmd Msg ) +init : { specUrl : String, servingHost : String } -> ( Model, Cmd Msg ) init flags = - ( Model flags.specUrl Maybe.Nothing Set.empty Dict.empty Dict.empty flags.servingHost, getJsonSpec flags.specUrl flags.servingHost) + ( Model flags.specUrl Maybe.Nothing Set.empty Dict.empty Dict.empty flags.servingHost, getJsonSpec flags.specUrl flags.servingHost ) @@ -30,234 +31,294 @@ init flags = type Msg - = FetchSpec (Maybe String) - | FetchSpecFail Http.Error - | FetchSpecOk Spec - | TryRequest (String, String) Http.Request - | ExpansionToggled (Set String) - | RequestFail Http.RawError - | RequestResult (String, String) Http.Response - | ParameterInput ParameterValues + = FetchSpec (Maybe String) + | FetchSpecFail Http.Error + | FetchSpecOk Spec + | TryRequest ( String, String ) Http.Request + | ExpansionToggled (Set String) + | RequestFail Http.RawError + | RequestResult ( String, String ) Http.Response + | ParameterInput ParameterValues update : Msg -> Model -> ( Model, Cmd Msg ) update action model = - case action of - FetchSpec maybeUrl -> - let - url = - (Maybe.withDefault model.specUrl maybeUrl) - in - ( Model url model.spec model.expanded model.paramValues model.requestResults model.servingHost - , getJsonSpec url model.servingHost - ) - - FetchSpecOk spec -> - ( Model model.specUrl (Maybe.Just spec) model.expanded model.paramValues model.requestResults model.servingHost - , Cmd.none - ) - - FetchSpecFail (Http.UnexpectedPayload error) -> - (Model model.specUrl Maybe.Nothing model.expanded model.paramValues model.requestResults model.servingHost - , debugCmd (debugOutput "Spec parse failure" error)) -- TODO: Actually show the error message to the user - - FetchSpecFail Http.Timeout -> - (Model model.specUrl Maybe.Nothing model.expanded model.paramValues model.requestResults model.servingHost - , debugCmd (debugOutput "Spec fetch timed out" "")) - - FetchSpecFail Http.NetworkError -> - (Model model.specUrl Maybe.Nothing model.expanded model.paramValues model.requestResults model.servingHost - , debugCmd (debugOutput "Spec fetch failed due to a network error" "")) - - FetchSpecFail (Http.BadResponse code msg) -> - (Model model.specUrl Maybe.Nothing model.expanded model.paramValues model.requestResults model.servingHost - , debugCmd (debugOutput "Spec fetch failed due to a http error" msg)) - - ExpansionToggled expanded -> - ( Model model.specUrl model.spec expanded model.paramValues model.requestResults model.servingHost - , Cmd.none - ) - - TryRequest (path', verb) request -> - ( model, tryRequest path' verb request ) - - RequestResult key result -> - ( Model model.specUrl model.spec model.expanded model.paramValues (Dict.insert key result model.requestResults) model.servingHost - , Cmd.none - ) - - RequestFail errorMsg -> - (model, Cmd.none) -- TODO Actually show the error message - - ParameterInput paramValues -> - ( Model model.specUrl model.spec model.expanded paramValues model.requestResults model.servingHost - , Cmd.none - ) + case action of + FetchSpec maybeUrl -> + let + url = + (Maybe.withDefault model.specUrl maybeUrl) + in + ( Model url model.spec model.expanded model.paramValues model.requestResults model.servingHost + , getJsonSpec url model.servingHost + ) + + FetchSpecOk spec -> + ( Model model.specUrl (Maybe.Just spec) model.expanded model.paramValues model.requestResults model.servingHost + , Cmd.none + ) + + FetchSpecFail (Http.UnexpectedPayload error) -> + ( Model model.specUrl Maybe.Nothing model.expanded model.paramValues model.requestResults model.servingHost + , debugCmd (debugOutput "Spec parse failure" error) + ) + + -- TODO: Actually show the error message to the user + FetchSpecFail (Http.Timeout) -> + ( Model model.specUrl Maybe.Nothing model.expanded model.paramValues model.requestResults model.servingHost + , debugCmd (debugOutput "Spec fetch timed out" "") + ) + + FetchSpecFail (Http.NetworkError) -> + ( Model model.specUrl Maybe.Nothing model.expanded model.paramValues model.requestResults model.servingHost + , debugCmd (debugOutput "Spec fetch failed due to a network error" "") + ) + + FetchSpecFail (Http.BadResponse code msg) -> + ( Model model.specUrl Maybe.Nothing model.expanded model.paramValues model.requestResults model.servingHost + , debugCmd (debugOutput "Spec fetch failed due to a http error" msg) + ) + + ExpansionToggled expanded -> + ( Model model.specUrl model.spec expanded model.paramValues model.requestResults model.servingHost + , Cmd.none + ) + + TryRequest ( path', verb ) request -> + ( model, tryRequest path' verb request ) + + RequestResult key result -> + ( Model model.specUrl model.spec model.expanded model.paramValues (Dict.insert key result model.requestResults) model.servingHost + , Cmd.none + ) + + RequestFail errorMsg -> + ( model, Cmd.none ) + + -- TODO Actually show the error message + ParameterInput paramValues -> + ( Model model.specUrl model.spec model.expanded paramValues model.requestResults model.servingHost + , Cmd.none + ) debugCmd : String -> Cmd Msg debugCmd error = - Cmd.none + Cmd.none + debugOutput : String -> String -> String debugOutput location msg = - Debug.log location msg + Debug.log location msg + tryRequest : String -> String -> Http.Request -> Cmd Msg tryRequest path' verb req = - let - settings = - Http.defaultSettings - in - Task.perform RequestFail (\r -> RequestResult (path', verb) r) (Http.send settings req) + let + settings = + Http.defaultSettings + in + Task.perform RequestFail (\r -> RequestResult ( path', verb ) r) (Http.send settings req) getJsonSpec : String -> String -> Cmd Msg getJsonSpec url servingHost = - Task.perform FetchSpecFail FetchSpecOk (Http.get (decodeSpec (extractHost url servingHost)) url) + Task.perform FetchSpecFail FetchSpecOk (Http.get (decodeSpec servingHost) url) type alias RequestResults = - Dict (String, String) Http.Response + Dict ( String, String ) Http.Response type alias ParameterKey = - ( String, String, String, String ) + ( String, String, String, String ) type alias ParameterValues = - Dict ParameterKey String + Dict ParameterKey String + + -- Used for JSON decoding + type alias Spec = - { info : Info, paths : Paths, swagger : String, host : String, basePath: String } + { info : Info + , paths : Paths + , swagger : String + , host : String + , basePath : String + , schemes : List String + } type alias Info = - { title : String, description : String, version : String } + { title : String, description : String, version : String } type alias Paths = - Dict String Operations + Dict String Operations type alias Parameter = - { in' : String, name : String, description : String, type': String } + { in' : String, name : String, description : String, type' : String } type alias Response = - { description : String } + { description : String } type alias Operations = - Dict String Operation + Dict String Operation type alias Operation = - { summary : String - , description : String - , parameters : List Parameter - , responses : Dict String Response - } + { summary : String + , description : String + , parameters : List Parameter + , responses : Dict String Response + } + typeInfoVal : String -> Json.Decoder Parameter typeInfoVal in' = - Json.object4 - Parameter - (Json.succeed in') - ("name" := Json.string) - (optionalField "description") - (Json.oneOf ["type" := Json.string, Json.succeed "schema"]) -- TODO check, must be one of string, number, integer, boolean, array, file + Json.object4 + Parameter + (Json.succeed in') + ("name" := Json.string) + (optionalField "description") + (Json.oneOf [ "type" := Json.string, Json.succeed "schema" ]) + + + +-- TODO check, must be one of string, number, integer, boolean, array, file + typeInfo : String -> Json.Decoder Parameter typeInfo in' = - case in' of - "body" -> - typeInfoVal in' - "query" -> - typeInfoVal in' - "header" -> - typeInfoVal in' - "path" -> - typeInfoVal in' - "formData" -> - typeInfoVal in' - _ -> - Json.fail (in' ++ " is not a recognized parameter location") + case in' of + "body" -> + typeInfoVal in' + + "query" -> + typeInfoVal in' + + "header" -> + typeInfoVal in' + + "path" -> + typeInfoVal in' + + "formData" -> + typeInfoVal in' + + _ -> + Json.fail (in' ++ " is not a recognized parameter location") decodeParameter : Json.Decoder Parameter decodeParameter = - ("in" := Json.string) `Json.andThen` typeInfo + ("in" := Json.string) `Json.andThen` typeInfo decodeResponse : Json.Decoder Response decodeResponse = - Json.object1 - Response - ("description" := Json.string) + Json.object1 + Response + ("description" := Json.string) decodeOperation : Json.Decoder Operation decodeOperation = - Json.object4 - Operation - (optionalField "summary") - (optionalField "description") - (Json.oneOf [ Json.at [ "parameters" ] <| Json.list decodeParameter, Json.succeed [] ]) - (Json.oneOf [ Json.at [ "responses" ] <| Json.dict decodeResponse, Json.succeed Dict.empty]) + Json.object4 + Operation + (optionalField "summary") + (optionalField "description") + (Json.oneOf [ Json.at [ "parameters" ] <| Json.list decodeParameter, Json.succeed [] ]) + (Json.oneOf [ Json.at [ "responses" ] <| Json.dict decodeResponse, Json.succeed Dict.empty ]) decodeOperations : Json.Decoder Operations decodeOperations = - Json.dict decodeOperation + Json.dict decodeOperation decodePaths : Json.Decoder Paths decodePaths = - Json.at - [ "paths" ] - <| Json.dict decodeOperations + Json.at + [ "paths" ] + <| + Json.dict decodeOperations decodeInfo : Json.Decoder Info decodeInfo = - Json.at - [ "info" ] - <| Json.object3 - Info - ("title" := Json.string) - (optionalField "description") - ("version" := Json.string) + Json.at + [ "info" ] + <| + Json.object3 + Info + ("title" := Json.string) + (optionalField "description") + ("version" := Json.string) optionalField : String -> Json.Decoder String optionalField field = - optionalFieldWithDefault field "" + optionalFieldWithDefault field "" + + +optionalListFieldWithDefault : String -> List String -> Json.Decoder (List String) +optionalListFieldWithDefault field default = + Json.oneOf [ field := Json.list Json.string, Json.succeed default ] + optionalFieldWithDefault : String -> String -> Json.Decoder String optionalFieldWithDefault field default = - Json.oneOf [ field := Json.string, Json.succeed default ] - -extractHost : String -> String -> String -extractHost url servingHost = -- expects servingHost to be something like: "localhost:1337" - let - parts = String.split "/" url - isHttp = (String.left 4 url) == "http" - in - case isHttp of - True -> - Maybe.withDefault servingHost (List.drop 2 parts |> List.head) - False -> - servingHost + Json.oneOf [ field := Json.string, Json.succeed default ] + + +hostFrom : String -> String +hostFrom uri = + let + parts = + String.split "/" uri + + isHttp = + (String.left 4 uri) == "http" + in + case isHttp of + True -> + Maybe.withDefault uri (List.drop 2 parts |> List.head) + + False -> + uri + + +protocolFrom : String -> String +protocolFrom uri = + let + parts = + String.split ":" uri + + isHttp = + (String.left 4 uri) == "http" + in + case isHttp of + True -> + Maybe.withDefault "http" (List.head parts) + + False -> + "file" + decodeSpec : String -> Json.Decoder Spec -decodeSpec defaultHost = - Json.object5 - Spec - decodeInfo - decodePaths - ("swagger" := Json.string) - (optionalFieldWithDefault "host" defaultHost) - (optionalField "basePath") +decodeSpec servingHost = + Json.object6 + Spec + decodeInfo + decodePaths + ("swagger" := Json.string) + (optionalFieldWithDefault "host" (hostFrom servingHost)) + (optionalField "basePath") + (optionalListFieldWithDefault "schemes" [ (protocolFrom servingHost) ]) diff --git a/src/View.elm b/src/View.elm index 233a5b0..bb20536 100644 --- a/src/View.elm +++ b/src/View.elm @@ -362,13 +362,25 @@ pathEntry pathName expanded opsList = ] +urlFromSpec : Spec -> String +urlFromSpec spec = + (Maybe.withDefault "http" (List.head spec.schemes) ++ "://" ++ spec.host ++ spec.basePath) + + pathList : Spec -> ParameterValues -> Set String -> RequestResults -> Html Msg pathList spec paramValues expanded results = div [] [ dl [] (List.map (\( pathName, ops ) -> - pathEntry pathName expanded (operationList ("http://" ++ spec.host ++ spec.basePath) paramValues pathName ops results) + pathEntry pathName + expanded + (operationList (urlFromSpec spec) + paramValues + pathName + ops + results + ) ) (Dict.toList spec.paths) )