lootalot-client/src/Api.elm

module Api exposing
    ( Claim
    , Claims
    , HttpResult
    , Item
    , Loot
    , Msg(..)
    , RequestData(..)
    , ToChest(..)
    , Update(..)
    , checkList
    , confirmAction
    , fetchClaimsOf
    , fetchLoot
    , replaceShopItems
    )

import Api.Player exposing (Player, Wealth)
import Http
import Json.Decode as D exposing (Decoder, field, int, string, succeed)
import Json.Encode as E


type alias HttpResult a =
    Result Http.Error a



-- Format of the server's response


type alias Response a =
    { value : Maybe a
    , notification : Maybe String
    , updates : Maybe (List Update)
    , errors : Maybe String
    }


type Update
    = ItemRemoved Item
    | ItemAdded Item
    | WealthUpdated Wealth
    | ClaimAdded Claim
    | ClaimRemoved Claim


type Msg
    = GotActionResult (HttpResult (Response ()))



---
-- MODELS
---
-- Player
-- Loot


type alias Item =
    { id : Int
    , name : String
    , base_price : Int
    }


itemDecoder =
    D.map3 Item
        (D.field "id" int)
        (D.field "name" string)
        (D.field "base_price" int)


itemEncoder item =
    E.object
        [ ( "id", E.int item.id )
        , ( "name", E.string item.name )
        , ( "base_price", E.int item.base_price )
        ]


type alias Loot =
    List Item



-- LOOT
-- Location of a loot


lootDecoder : Decoder Loot
lootDecoder =
    D.list itemDecoder


type ToChest
    = OfPlayer Int
    | OfGroup
    | OfShop


fetchLoot : (ToChest -> Result Http.Error Loot -> msg) -> ToChest -> Cmd msg
fetchLoot toMsg dest =
    let
        url =
            case dest of
                OfPlayer id ->
                    "http://localhost:8088/api/players/" ++ String.fromInt id ++ "/loot"

                OfShop ->
                    "http://localhost:8088/api/shop"

                OfGroup ->
                    "http://localhost:8088/api/players/0/loot"
    in
    Http.get
        { url = url
        , expect = Http.expectJson (toMsg dest) (valueDecoder lootDecoder)
        }



-- Claims


type alias Claims =
    List Claim


type alias Claim =
    { id : Int
    , player_id : Int
    , loot_id : Int
    }


claimDecoder =
    D.map3 Claim
        (D.field "id" int)
        (D.field "player_id" int)
        (D.field "loot_id" int)


fetchClaimsOf : (Result Http.Error Claims -> msg) -> Int -> Cmd msg
fetchClaimsOf toMsg playerId =
    let
        url =
            case playerId of
                -- The 'group' need to see all claims
                0 ->
                    "http://localhost:8088/api/claims"

                id ->
                    "http://localhost:8088/api/players/" ++ String.fromInt playerId ++ "/claims"
    in
    Http.get
        { url = url
        , expect =
            valueDecoder (D.list claimDecoder)
                |> Http.expectJson toMsg
        }



-- Retrieves items from a list of names


checkList : (Loot -> Maybe String -> msg) -> List String -> Cmd msg
checkList toMsg itemList =
    let
        parseResponse : Result Http.Error (Response Loot) -> msg
        parseResponse response =
            case response of
                Ok r ->
                    let
                        items =
                            case r.value of
                                Just loot ->
                                    loot

                                _ ->
                                    []

                        errors =
                            case r.errors of
                                Nothing ->
                                    Nothing

                                Just e ->
                                    if e == "" then
                                        Nothing

                                    else
                                        Just e
                    in
                    toMsg (Debug.log "CheckList, got items" items) errors

                Err e ->
                    toMsg [] <| Just (printError e)
    in
    Http.post
        { url = "http://localhost:8088/api/items"
        , body =
            E.list (\t -> E.string t) itemList
                |> Http.jsonBody
        , expect = Http.expectJson parseResponse (apiResponseDecoder lootDecoder)
        }



-- API RESPONSE
--
-- Loot-a-lot API use a flat response format with four fields :
--   * value
--   * notification
--   * updates
--   * errors


valueDecoder : Decoder a -> Decoder a
valueDecoder thenDecoder =
    D.field "value" thenDecoder



-- TODO: update server to produce better json
--       like an object with list of updates of the same type
--       { ItemRemoved : [..], Wealth : [ .. ], .. }


updatesDecoder : Decoder Update
updatesDecoder =
    -- We expect one update but do not know it's kind
    D.oneOf
        [ field "ItemRemoved" (itemDecoder |> D.andThen (\i -> succeed <| ItemRemoved i))
        , field "ItemAdded" (itemDecoder |> D.andThen (\i -> succeed <| ItemAdded i))
        , field "Wealth" (Api.Player.wealthDecoder |> D.andThen (\i -> succeed <| WealthUpdated i))
        , field "ClaimRemoved" (claimDecoder |> D.andThen (\i -> succeed <| ClaimRemoved i))
        , field "ClaimAdded" (claimDecoder |> D.andThen (\i -> succeed <| ClaimAdded i))
        ]



-- The 'value' field is actually a union-type
-- with heterogeneous data. We need to provide a
-- decoder to extract the value we expect, or ignore
-- it with ().


apiResponseDecoder : Decoder a -> Decoder (Response a)
apiResponseDecoder toValue =
    D.map4 Response
        (D.maybe (field "value" toValue))
        (D.maybe (field "notification" string))
        (D.maybe (field "updates" (D.list updatesDecoder)))
        (D.maybe (field "errors" string))



{- ACTIONS

   Actions that can be taken on a selection of items

-}


type RequestData
    = SellPayload Loot (Maybe Float) (List (Maybe Float)) (List Int)
    | BuyPayload Loot (Maybe Float) (List (Maybe Float))
    | GrabPayload Loot
    | AddPayload String Loot
    | WealthPayload Float


zip xs ys =
    List.map2 Tuple.pair xs ys


itemsWithMods items mods =
    zip items mods
        |> E.list
            (\( item, mod ) ->
                E.list identity
                    [ E.int item.id
                    , case mod of
                        Just m ->
                            E.float m

                        Nothing ->
                            E.null
                    ]
            )


buildPayload : RequestData -> E.Value
buildPayload data =
    case data of
        BuyPayload items gMod iMods ->
            E.object
                [ ( "items", itemsWithMods items iMods )
                , ( "global_mod"
                  , case gMod of
                        Nothing ->
                            E.null

                        Just f ->
                            E.float f
                  )
                ]

        SellPayload items gMod iMods players ->
            E.object
                [ ( "items", itemsWithMods items iMods )
                , ( "global_mod"
                  , case gMod of
                        Nothing ->
                            E.null

                        Just f ->
                            E.float f
                  )
                , ( "players", E.list (\id -> E.int id) players )
                ]

        -- API expects the list of claimed items ids
        GrabPayload items ->
            items |> E.list (\i -> E.int i.id)

        AddPayload sourceName items ->
            E.object
                [ ( "items", items |> E.list itemEncoder )
                , ( "source_name", E.string sourceName )
                ]

        WealthPayload amount ->
            E.float amount


confirmAction : String -> RequestData -> Cmd Msg
confirmAction id data =
    let
        ( endpoint, method ) =
            case data of
                AddPayload _ _ ->
                    ( "http://localhost:8088/api/players/" ++ id ++ "/loot"
                    , "POST"
                    )

                BuyPayload _ _ _ ->
                    ( "http://localhost:8088/api/players/" ++ id ++ "/loot"
                    , "PUT"
                    )

                SellPayload _ _ _ _ ->
                    ( "http://localhost:8088/api/players/" ++ id ++ "/loot"
                    , "DELETE"
                    )

                GrabPayload _ ->
                    ( "http://localhost:8088/api/players/" ++ id ++ "/claims"
                    , "POST"
                    )

                WealthPayload _ ->
                    ( "http://localhost:8088/api/players/" ++ id ++ "/wealth"
                    , "PUT"
                    )
    in
    Http.request
        { method = method
        , headers = []
        , url = endpoint
        , body = Http.jsonBody <| buildPayload data
        , expect = Http.expectJson GotActionResult (apiResponseDecoder <| D.succeed ())
        , timeout = Nothing
        , tracker = Nothing
        }


undoLastAction id =
    Http.request
        { url = "http://localhost:8088/api/players/" ++ String.fromInt id ++ "/events/last"
        , method = "DELETE"
        , headers = []
        , body = Http.emptyBody
        , expect = Http.expectJson GotActionResult (apiResponseDecoder <| D.succeed ())
        , timeout = Nothing
        , tracker = Nothing
        }



-- ADMIN
--


replaceShopItems : (Maybe () -> msg) -> Loot -> Cmd msg
replaceShopItems toMsg loot =
    let
        data =
            E.list itemEncoder loot

        gotResponse : HttpResult (Response ()) -> msg
        gotResponse response =
            case response of
                Ok apiResponse ->
                    toMsg apiResponse.value

                Err error ->
                    toMsg Nothing
    in
    Http.request
        { url = "http://localhost:8088/api/shop"
        , method = "POST"
        , headers = []
        , body = Http.jsonBody data
        , expect = Http.expectJson gotResponse (apiResponseDecoder <| D.succeed ())
        , timeout = Nothing
        , tracker = Nothing
        }



-- UTILS


printError : Http.Error -> String
printError error =
    case error of
        Http.NetworkError ->
            "Le serveur ne répond pas"

        _ ->
            "Erreur inconnue"