lamassu-server/lamassu-admin-elm/src/NavBar.elm

module NavBar exposing (view, routeToUrl)

import Html exposing (Html, Attribute, a, div, hr, input, span, text, ul, li, nav)
import Html.Events exposing (onClick)
import Html.CssHelpers
import Css.Classes
import String
import CoreTypes
    exposing
        ( Msg(..)
        , Category(..)
        , Route(..)
        )


{ id, class, classList } =
    Html.CssHelpers.withNamespace "lamassuAdmin"


maybeUrl : String -> List (Maybe String) -> String
maybeUrl root maybeStrings =
    List.filterMap identity maybeStrings
        |> List.append [ root ]
        |> String.join "/"


routeToUrl : Route -> String
routeToUrl route =
    case route of
        PairRoute ->
            "/#pair"

        AccountRoute account ->
            "/#account/" ++ account

        ConfigRoute configGroup maybeCrypto ->
            maybeUrl ("/#config/" ++ configGroup) [ maybeCrypto ]

        MaintenanceMachinesRoute ->
            "/#machines/"

        MaintenanceFundingRoute maybeCrypto ->
            maybeUrl ("/#funding") [ maybeCrypto ]

        TransactionsRoute ->
            "/#transactions/"

        TransactionRoute txId ->
            "/#transaction/" ++ txId

        CustomersRoute ->
            "/#customers/"

        CustomerRoute id ->
            "/#customer/" ++ id

        LogsRoute maybeId ->
            "/#logs/" ++ (Maybe.withDefault "" maybeId)

        SupportLogsRoute maybeId ->
            "/#support_logs/" ++ (Maybe.withDefault "" maybeId)

        NotFoundRoute ->
            Debug.crash "Need unknown route"


linkClasses : Route -> Route -> Bool -> Attribute msg
linkClasses linkRoute route isValid =
    let
        validityClass =
            if isValid then
                []
            else
                [ Css.Classes.InvalidGroup ]

        active =
            case route of
                ConfigRoute config _ ->
                    linkRoute == ConfigRoute config Nothing

                MaintenanceFundingRoute _ ->
                    linkRoute == MaintenanceFundingRoute Nothing

                LogsRoute _ ->
                    linkRoute == LogsRoute Nothing

                _ ->
                    linkRoute == route
    in
        if (active) then
            class ([ Css.Classes.NavBarRoute, Css.Classes.Active ] ++ validityClass)
        else
            class ([ Css.Classes.NavBarRoute ] ++ validityClass)


type alias Link =
    ( String, Route, Bool )


activeCategory : Maybe Category -> Category -> Bool -> Attribute msg
activeCategory maybeCurrentCategory linkedCategory isValid =
    let
        validityClass =
            if isValid then
                []
            else
                [ Css.Classes.InvalidGroup ]
    in
        case maybeCurrentCategory of
            Nothing ->
                class ([ Css.Classes.NavBarCategory ] ++ validityClass)

            Just currentCategory ->
                if currentCategory == linkedCategory then
                    class ([ Css.Classes.NavBarCategory, Css.Classes.Active ] ++ validityClass)
                else
                    class ([ Css.Classes.NavBarCategory ] ++ validityClass)


categoryView : Maybe Category -> ( String, Category, Route, Bool ) -> Html Msg
categoryView currentCategory link =
    let
        ( desc, category, linkRoute, isValid ) =
            link
    in
        div
            [ onClick (NewUrl (routeToUrl linkRoute))
            , activeCategory currentCategory category isValid
            ]
            [ text desc ]


linkView : Maybe Category -> Route -> Maybe Category -> Link -> Html Msg
linkView maybeCategory currentRoute maybeLinkedCategory link =
    let
        ( desc, linkRoute, isValid ) =
            link
    in
        div [ onClick (NewUrl (routeToUrl linkRoute)), linkClasses linkRoute currentRoute isValid ] [ text desc ]


linksView : Maybe Category -> Route -> ( String, Category, Route, Bool ) -> List Link -> Html Msg
linksView maybeCurrentCategory currentRoute ( catDesc, cat, route, isValid ) links =
    if maybeCurrentCategory == (Just cat) then
        div [ class [ Css.Classes.NavBarCategoryContainer ] ]
            [ categoryView maybeCurrentCategory ( catDesc, cat, route, isValid )
            , div [] (List.map (linkView maybeCurrentCategory currentRoute (Just cat)) links)
            ]
    else
        div [ class [ Css.Classes.NavBarCategoryContainer ] ]
            [ categoryView maybeCurrentCategory ( catDesc, cat, route, isValid )
            ]


determineConfigCategory : String -> Maybe Category
determineConfigCategory configCode =
    if List.member configCode [ "definition", "setup", "cashOut", "commissions", "balanceAlerts" ] then
        Just MachineSettingsCat
    else if List.member configCode [ "walletSettings", "notifications", "compliance", "coinAtmRadar", "terms", "operatorInfo" ] then
        Just GlobalSettingsCat
    else
        Nothing


allClear : List String -> Category -> Bool
allClear invalidGroups cat =
    not <| List.any (\groupCode -> determineConfigCategory groupCode == Just cat) invalidGroups


determineCategory : Route -> Maybe Category
determineCategory route =
    case route of
        AccountRoute account ->
            Just AccountCat

        ConfigRoute config _ ->
            determineConfigCategory config

        MaintenanceMachinesRoute ->
            Just MaintenanceCat

        MaintenanceFundingRoute _ ->
            Just MaintenanceCat

        PairRoute ->
            Nothing

        TransactionsRoute ->
            Nothing

        TransactionRoute _ ->
            Nothing

        CustomersRoute ->
            Just MaintenanceCat

        CustomerRoute _ ->
            Just MaintenanceCat

        LogsRoute _ ->
            Just MaintenanceCat

        SupportLogsRoute _ ->
            Nothing

        NotFoundRoute ->
            Nothing


view : Route -> List String -> Html Msg
view route invalidGroups =
    let
        maybeCategory =
            determineCategory route

        l =
            linkView maybeCategory route Nothing

        ll =
            linksView maybeCategory route

        isValid group =
            not (List.member group invalidGroups)

        allClearMachine =
            allClear invalidGroups MachineSettingsCat

        allClearGlobal =
            allClear invalidGroups GlobalSettingsCat

        configLink code display =
            ( display, ConfigRoute code Nothing, isValid code )
    in
        nav [ class [ Css.Classes.NavBar ] ]
            [ l ( "Transactions", TransactionsRoute, True )
            , ll ( "Maintenance", MaintenanceCat, MaintenanceMachinesRoute, True )
                [ ( "Machines", MaintenanceMachinesRoute, True )
                , ( "Funding", MaintenanceFundingRoute Nothing, True )
                , ( "Customers", CustomersRoute, True )
                , ( "Logs", LogsRoute Nothing, True )
                ]
            , ll ( "Machine Settings", MachineSettingsCat, ConfigRoute "definition" Nothing, allClearMachine )
                [ configLink "definition" "Definition"
                , configLink "setup" "Setup"
                , configLink "cashOut" "Cash Out"
                , configLink "commissions" "Commissions"
                , configLink "balanceAlerts" "Balance Alerts"
                ]
            , ll ( "Global Settings", GlobalSettingsCat, ConfigRoute "walletSettings" Nothing, allClearGlobal )
                [ configLink "walletSettings" "Wallet Settings"
                , configLink "notifications" "Notifications"
                , configLink "compliance" "Compliance"
                , configLink "coinAtmRadar" "Coin ATM Radar"
                , configLink "terms" "Terms and Conditions"
                , configLink "operatorInfo" "Operator Info"
                ]
            , ll ( "Third Party Services", AccountCat, AccountRoute "bitgo", True )
                [ ( "BitGo", AccountRoute "bitgo", True )
                , ( "Bitstamp", AccountRoute "bitstamp", True )
                , ( "Blockcypher", AccountRoute "blockcypher", True )
                , ( "Infura", AccountRoute "infura", True )
                , ( "itBit", AccountRoute "itbit", True )
                , ( "Kraken", AccountRoute "kraken", True )
                , ( "Mailgun", AccountRoute "mailgun", True )
                , ( "Strike", AccountRoute "strike", True )
                , ( "Twilio", AccountRoute "twilio", True )
                ]
            , l ( "+ Add Machine", PairRoute, True )
            ]