Tunnel binary through http using elm 0.17

elm-package.json

{
    "version": "1.0.2",
    "summary": "test http",
    "repository": "https://github.com/newlandsvalley/foobar.git",
    "license": "BSD3",
    "source-directories": [
    ],
    "exposed-modules": [
    ],
    "native-modules": false,
    "dependencies": {
        "elm-lang/core": "4.0.0 <= v < 5.0.0",
        "elm-lang/html": "1.0.0 <= v < 2.0.0",
        "evancz/elm-http": "3.0.1 <= v < 4.0.0"
    },
    "elm-version": "0.17.0 <= v < 0.18.0"
}

TunnelBinary17.elm

module TunnelBinary17 exposing (..)

import Html exposing (..)
import Html.Events exposing (onClick)
import Html.App as Html
import Http exposing (..)
import Task exposing (..)
import List exposing (..)
import String exposing (..)
import Result exposing (Result)
import Char exposing (fromCode, toCode)
import Bitwise exposing (and)


main =
    Html.program
        { init = init "test binary http 0.17", update = update, view = view, subscriptions = \_ -> Sub.none }



-- MODEL


type alias MidiRecording =
    List Int


type alias Model =
    { recording : Result String MidiRecording
    }


init : String -> ( Model, Cmd Msg )
init topic =
    ( { recording = Err "not started" }
    , Cmd.none
    )



-- UPDATE


type Msg
    = NoOp
    | Load String
    | Midi (Result String MidiRecording)
    | MidiBinaryString (Result String Value)


update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
    case msg of
        NoOp ->
            ( model, Cmd.none )

        MidiBinaryString result ->
            update (Midi (makeRecording result)) model

        Midi recording ->
            ( { recording = recording }, Cmd.none )

        Load url ->
            ( model, loadMidi url )



{- load a MIDI file -}


loadMidi : String -> Cmd Msg
loadMidi url =
    let
        settings =
            { defaultSettings | desiredResponseType = Just "text/plain; charset=x-user-defined" }
    in
        Http.send settings
            { verb = "GET"
            , headers = []
            , url = url
            , body = empty
            }
            |> Task.toResult
            |> Task.map extractResponse
            |> Task.perform (\_ -> NoOp) MidiBinaryString



{- extract the true response, concentrating on 200 statuses - assume other statuses are in error
   (usually 404 not found)
-}


extractResponse : Result RawError Response -> Result String Value
extractResponse result =
    case result of
        Ok response ->
            case response.status of
                200 ->
                    Ok response.value

                _ ->
                    Err (toString (response.status) ++ ": " ++ response.statusText)

        Err e ->
            Err "unexpected http error"


makeRecording : Result String Value -> Result String MidiRecording
makeRecording r =
    case r of
        Ok text ->
            case text of
                Text s ->
                    s |> normalise |> Ok

                Blob b ->
                    Err "Blob unsupported"

        Err e ->
            Err e



{- attempt to get back the original binary -}


normalise : String -> MidiRecording
normalise =
    let
        f =
            toCode >> ((and) 0xFF)
    in
        String.toList >> List.map f



-- VIEW


viewParseResult : Result String MidiRecording -> String
viewParseResult mr =
    case mr of
        Ok res ->
            "OK: " ++ (toString res)

        Err errs ->
            "Fail: " ++ (toString errs)


view : Model -> Html Msg
view model =
    div []
        [ button [ onClick (Load "chordsample.midi") ] [ text "load MIDI sample" ]
        , div [] [ text ("parse result: " ++ (viewParseResult model.recording)) ]
        ]