From ae737285faa00a37ea03198241f393b99abb41f5 Mon Sep 17 00:00:00 2001 From: Prashant Singh Pawar Date: Sun, 7 May 2017 18:36:34 -0400 Subject: [PATCH 01/13] - Added ContractCreator page - Refactored the Model to reflect the modules --- app/elm/Main.elm | 30 +++++++++------------- app/elm/Models.elm | 35 ++++++++++++++++++++++++- app/elm/Msgs.elm | 5 +++- app/elm/Update.elm | 31 +++++++++++++++++++--- app/elm/UrlParsing.elm | 15 +++++++++++ app/elm/View.elm | 50 +++++++++++++++++++++++------------- app/index.html | 1 + app/javascripts/index.js | 2 +- contracts/BrehonContract.sol | 4 +-- elm-package.json | 4 ++- 10 files changed, 132 insertions(+), 45 deletions(-) create mode 100644 app/elm/UrlParsing.elm diff --git a/app/elm/Main.elm b/app/elm/Main.elm index fb4365d..d293ddd 100644 --- a/app/elm/Main.elm +++ b/app/elm/Main.elm @@ -1,34 +1,28 @@ port module Main exposing (..) -import Html exposing (Html, div, text, program) +import Html exposing (Html, div, text) import Msgs exposing (Msg) -import Models exposing (Model, Party, zeroWei, initContractInfo, Brehon, PartyModel, BrehonModel, ContractInfo, Stage(..)) +import Models exposing (Model, Party, zeroWei, initContractModel, initContractCreatorModel, Brehon, PartyModel, BrehonModel, ContractInfo, Stage(..)) import Time exposing (every, minute, second) import View exposing (view) import Update exposing (update) import Web3.BrehonAPI exposing (..) import Commands exposing (..) +import Navigation +import UrlParser as Url +import UrlParsing exposing (..) -- MODEL -init : ( Model, Cmd Msg ) -init = +init : Navigation.Location -> ( Model, Cmd Msg ) +init location = ( Model - initContractInfo - 0 - [] - Nothing - zeroWei - zeroWei - zeroWei - zeroWei - (PartyModel (Party Nothing zeroWei False)) - (PartyModel (Party Nothing zeroWei False)) - (BrehonModel (Brehon Nothing False zeroWei zeroWei) Nothing) - (BrehonModel (Brehon Nothing False zeroWei zeroWei) Nothing) - (BrehonModel (Brehon Nothing False zeroWei zeroWei) Nothing) + [ Url.parseHash route location ] + (Just Create) + initContractCreatorModel + initContractModel , Cmd.batch [ loadWeb3Accounts , loadContractInfo @@ -72,7 +66,7 @@ subscriptions model = main : Program Never Model Msg main = - program + Navigation.program Msgs.UrlChange { init = init , view = view , update = update diff --git a/app/elm/Models.elm b/app/elm/Models.elm index 4a9a985..5a17d89 100644 --- a/app/elm/Models.elm +++ b/app/elm/Models.elm @@ -3,18 +3,52 @@ module Models exposing (..) import Time.DateTime as DateTime exposing (DateTime, dateTime) import Time as Time exposing (Time, now) +import UrlParsing exposing (Route) + zeroWei : Wei zeroWei = "0" +initContractModel : ContractModel +initContractModel = + ContractModel + initContractInfo + 0 + [] + Nothing + zeroWei + zeroWei + zeroWei + zeroWei + (PartyModel (Party Nothing zeroWei False)) + (PartyModel (Party Nothing zeroWei False)) + (BrehonModel (Brehon Nothing False zeroWei zeroWei) Nothing) + (BrehonModel (Brehon Nothing False zeroWei zeroWei) Nothing) + (BrehonModel (Brehon Nothing False zeroWei zeroWei) Nothing) + initContractInfo : ContractInfo initContractInfo = ContractInfo Nothing Negotiation zeroWei zeroWei False False Nothing Nothing Nothing 0 False Nothing Nothing +initContractCreatorModel : ContractCreatorModel +initContractCreatorModel = + ContractCreatorModel "party A" + type alias Model = + { history : List (Maybe Route) + , currentRoute : Maybe Route + , creatorModel : ContractCreatorModel + , contractModel : ContractModel + } + +type alias ContractCreatorModel = + { partyA : String + } + +type alias ContractModel = { contractInfo : ContractInfo , currentTimestamp : Time , eventLog : List Event @@ -30,7 +64,6 @@ type alias Model = , tertiaryBrehon : BrehonModel } - type alias ContractInfo = { deployedAt : Address , stage : Stage diff --git a/app/elm/Msgs.elm b/app/elm/Msgs.elm index b0c6a55..9e9c936 100644 --- a/app/elm/Msgs.elm +++ b/app/elm/Msgs.elm @@ -15,9 +15,12 @@ import Models , Event ) +import Navigation + type Msg - = LoadAccounts (List Address) + = UrlChange Navigation.Location + | LoadAccounts (List Address) | LoadContractInfo ( Address, Int, Wei, Wei, Int, Address, Maybe Awards ) | LoadAllParties Parties | LoadAllBrehons Brehons diff --git a/app/elm/Update.elm b/app/elm/Update.elm index 95b5f0c..1cde32e 100644 --- a/app/elm/Update.elm +++ b/app/elm/Update.elm @@ -1,14 +1,39 @@ module Update exposing (..) +import Tuple exposing (first, second) import Msgs exposing (..) import Time.DateTime as DateTime exposing (DateTime, dateTime, zero, addDays, fromISO8601, compare, fromTimestamp) import Time as Time exposing (Time) -import Models exposing (Model, Stage(..), Event(..), ContractInfo, Settlement, Awards, Address, Wei, zeroWei, Parties, PartyModel, Party, Brehons, BrehonModel, Brehon) +import Models exposing (Model, ContractCreatorModel, ContractModel, Stage(..), Event(..), ContractInfo, Settlement, Awards, Address, Wei, zeroWei, Parties, PartyModel, Party, Brehons, BrehonModel, Brehon) import Commands exposing (..) +import UrlParser as Url exposing (..) +import UrlParsing exposing (route) + update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = + case msg of + UrlChange location -> + let + nextRoute = + Url.parseHash route location + + in + { model + | history = nextRoute :: model.history + , currentRoute = nextRoute + } + ! [] + _ -> + let + updatedContractMsg = updateContract msg model.contractModel + in + ( {model | contractModel = first updatedContractMsg }, second updatedContractMsg) + + +updateContract : Msg -> ContractModel -> (ContractModel, Cmd Msg) +updateContract msg model = case msg of LoadAccounts accounts -> ( setLoadedAddress model (List.head accounts), Cmd.none ) @@ -209,7 +234,7 @@ update msg model = RaiseSecondAppeal addr -> ( model, raiseSecondAppeal addr ) - None -> + _ -> ( model, Cmd.none ) @@ -230,7 +255,7 @@ getBrehonsAcceptance brehons = ] -setLoadedAddress : Model -> Maybe Address -> Model +setLoadedAddress : ContractModel -> Maybe Address -> ContractModel setLoadedAddress model address = case address of Nothing -> diff --git a/app/elm/UrlParsing.elm b/app/elm/UrlParsing.elm new file mode 100644 index 0000000..33d2e9e --- /dev/null +++ b/app/elm/UrlParsing.elm @@ -0,0 +1,15 @@ +module UrlParsing exposing (..) + +import UrlParser as Url exposing (..) + +type Route + = Create + | Contract + + +route : Url.Parser (Route -> a) a +route = + Url.oneOf + [ Url.map Create top + , Url.map Contract (s "contract") + ] diff --git a/app/elm/View.elm b/app/elm/View.elm index df35431..bd3c3ee 100644 --- a/app/elm/View.elm +++ b/app/elm/View.elm @@ -5,29 +5,43 @@ import Html.Attributes exposing (class, href, src, type_, placeholder) import Html.Events exposing (onClick, onInput) import Time.DateTime as DateTime exposing (toISO8601, fromTimestamp) import Msgs exposing (Msg) -import Models exposing (Model, Address, Event(..), ContractInfo, Settlement, Awards, Wei, PartyModel, BrehonModel, FilePath, AppealLevel(..), Stage(..)) +import Models exposing (Model, ContractCreatorModel, ContractModel, Address, Event(..), ContractInfo, Settlement, Awards, Wei, PartyModel, BrehonModel, FilePath, AppealLevel(..), Stage(..)) + +import UrlParsing exposing (..) view : Model -> Html Msg view model = - div [ class "main-container lg-h4 md-h4 sm-h4 clearfix" ] - [ contractDetailView model - , div [ class "col col-8" ] - [ div [ class "party-list flex flex-wrap" ] - [ partyView model.partyA "images/partyA.png" model - , partyView model.partyB "images/partyB.png" model - ] - , div [ class "brehon-list flex flex-wrap flex-column" ] - [ brehonView model.primaryBrehon "images/partyPrimaryBrehon.png" model - , brehonView model.secondaryBrehon "images/partySecondaryBrehon.png" model - , brehonView model.tertiaryBrehon "images/partyTertiaryBrehon.png" model + case model.currentRoute of + Just Create -> + div [ class "main-container lg-h4 md-h4 sm-h4 clearfix" ] + [ contractCreatorView model.creatorModel ] + + Just Contract -> + div [ class "main-container lg-h4 md-h4 sm-h4 clearfix" ] + [ contractDetailView model.contractModel + , div [ class "col col-8" ] + [ div [ class "party-list flex flex-wrap" ] + [ partyView model.contractModel.partyA "images/partyA.png" model.contractModel + , partyView model.contractModel.partyB "images/partyB.png" model.contractModel + ] + , div [ class "brehon-list flex flex-wrap flex-column" ] + [ brehonView model.contractModel.primaryBrehon "images/partyPrimaryBrehon.png" model.contractModel + , brehonView model.contractModel.secondaryBrehon "images/partySecondaryBrehon.png" model.contractModel + , brehonView model.contractModel.tertiaryBrehon "images/partyTertiaryBrehon.png" model.contractModel + ] ] + , div [ class "col col-2 lg-h4 sm-h6" ] [ logView model.contractModel ] ] - , div [ class "col col-2 lg-h4 sm-h6" ] [ logView model ] - ] + Nothing -> + div [] [ text "Not found 404" ] + +contractCreatorView : ContractCreatorModel -> Html Msg +contractCreatorView model = + text "contractCreatorView" -contractDetailView : Model -> Html Msg +contractDetailView : ContractModel -> Html Msg contractDetailView model = let showProposedSettlement = @@ -180,7 +194,7 @@ canDepositIntoContract party contractInfo = /= Completed -partyView : PartyModel -> FilePath -> Model -> Html Msg +partyView : PartyModel -> FilePath -> ContractModel -> Html Msg partyView party profileImage model = let ownerView = @@ -428,7 +442,7 @@ awardsView awards = ] -brehonView : BrehonModel -> FilePath -> Model -> Html Msg +brehonView : BrehonModel -> FilePath -> ContractModel -> Html Msg brehonView brehon profileImage model = let ownerView = @@ -585,7 +599,7 @@ contractAcceptanceView isContractAccepted ownerView messageDispatch = ] -logView : Model -> Html Msg +logView : ContractModel -> Html Msg logView model = ul [ class "list-reset" ] (model.eventLog diff --git a/app/index.html b/app/index.html index 7fa6b77..6da53dd 100644 --- a/app/index.html +++ b/app/index.html @@ -4,6 +4,7 @@ Brehon Contract - Truffle Webpack Demo w/ Frontend +
diff --git a/app/javascripts/index.js b/app/javascripts/index.js index 9dd9319..a86fd84 100644 --- a/app/javascripts/index.js +++ b/app/javascripts/index.js @@ -273,7 +273,7 @@ function portHooks(elmApp, currentProvider) { .then(() => updateContractInfo(ports, brehonApp))); } -document.addEventListener('DOMContentLoaded', () => { +window.addEventListener('load', () => { const mountNode = document.getElementById('main'); const brehonElmApp = Elm.Main.embed(mountNode); diff --git a/contracts/BrehonContract.sol b/contracts/BrehonContract.sol index c882fea..c21f081 100644 --- a/contracts/BrehonContract.sol +++ b/contracts/BrehonContract.sol @@ -54,7 +54,7 @@ contract BrehonContract is event DisputeResolved(uint awardPartyA, uint awardPartyB); event FundsClaimed(address claimingParty, uint amount); - modifier byEitherEntities() { + modifier byAnyEntity() { if (msg.sender != primaryBrehon.addr && msg.sender != secondaryBrehon.addr && msg.sender != tertiaryBrehon.addr && @@ -240,7 +240,7 @@ contract BrehonContract is } function claimFunds() - byEitherEntities() + byAnyEntity() { if (stage != Stages.Completed) { if (stage != Stages.AppealPeriod && stage != Stages.SecondAppealPeriod) { diff --git a/elm-package.json b/elm-package.json index e6599e2..e85aa17 100644 --- a/elm-package.json +++ b/elm-package.json @@ -11,7 +11,9 @@ "debois/elm-mdl": "8.1.0 <= v < 9.0.0", "elm-community/elm-time": "1.0.3 <= v < 2.0.0", "elm-lang/core": "5.1.1 <= v < 6.0.0", - "elm-lang/html": "2.0.0 <= v < 3.0.0" + "elm-lang/html": "2.0.0 <= v < 3.0.0", + "elm-lang/navigation": "2.1.0 <= v < 3.0.0", + "evancz/url-parser": "2.0.1 <= v < 3.0.0" }, "elm-version": "0.18.0 <= v < 0.19.0" } From 2127334f9910411d82d6616bd42d9dda631dab11 Mon Sep 17 00:00:00 2001 From: Prashant Singh Pawar Date: Sun, 7 May 2017 19:13:01 -0400 Subject: [PATCH 02/13] - Added better handling of update msg method --- app/elm/Update.elm | 140 +++++++++++++++++++++++++++++++++++++-------- app/elm/View.elm | 106 ++++++++++++++++++---------------- 2 files changed, 175 insertions(+), 71 deletions(-) diff --git a/app/elm/Update.elm b/app/elm/Update.elm index 1cde32e..886c5b1 100644 --- a/app/elm/Update.elm +++ b/app/elm/Update.elm @@ -6,33 +6,127 @@ import Time.DateTime as DateTime exposing (DateTime, dateTime, zero, addDays, fr import Time as Time exposing (Time) import Models exposing (Model, ContractCreatorModel, ContractModel, Stage(..), Event(..), ContractInfo, Settlement, Awards, Address, Wei, zeroWei, Parties, PartyModel, Party, Brehons, BrehonModel, Brehon) import Commands exposing (..) - import UrlParser as Url exposing (..) import UrlParsing exposing (route) update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = - case msg of - UrlChange location -> - let - nextRoute = - Url.parseHash route location - - in - { model - | history = nextRoute :: model.history - , currentRoute = nextRoute - } - ! [] - _ -> - let - updatedContractMsg = updateContract msg model.contractModel - in - ( {model | contractModel = first updatedContractMsg }, second updatedContractMsg) + let + updatedContractMsg = + updateContract msg model.contractModel + in + case msg of + UrlChange location -> + let + nextRoute = + Url.parseHash route location + in + { model + | history = nextRoute :: model.history + , currentRoute = nextRoute + } + ! [] + + {- This Horrible pattern (where I repeat these case handling here and + in updateContract method) exists because I want compiler to catch + any new Msgs added. In future maybe this can be refactored. + -} + LoadAccounts accounts -> + ( { model | contractModel = first updatedContractMsg }, second updatedContractMsg ) + + LoadContractInfo ( deployedAddr, stage, transactionAmount, minimumContractAmt, appealPeriodInDays, activeBrehon, awards ) -> + ( { model | contractModel = first updatedContractMsg }, second updatedContractMsg ) + + LoadAllParties parties -> + ( { model | contractModel = first updatedContractMsg }, second updatedContractMsg ) + + LoadAllBrehons brehons -> + ( { model | contractModel = first updatedContractMsg }, second updatedContractMsg ) + + AcceptContractByParty partyModel -> + ( { model | contractModel = first updatedContractMsg }, second updatedContractMsg ) + + AcceptContractByBrehon brehonModel -> + ( { model | contractModel = first updatedContractMsg }, second updatedContractMsg ) + + DepositFieldChanged amount -> + ( { model | contractModel = first updatedContractMsg }, second updatedContractMsg ) + + DepositFunds partyModel -> + ( { model | contractModel = first updatedContractMsg }, second updatedContractMsg ) + + SettlementPartyAFieldChanged amount -> + ( { model | contractModel = first updatedContractMsg }, second updatedContractMsg ) + + SettlementPartyBFieldChanged amount -> + ( { model | contractModel = first updatedContractMsg }, second updatedContractMsg ) + + StartContract partyModel -> + ( { model | contractModel = first updatedContractMsg }, second updatedContractMsg ) + + LoadProposedSettlement proposedSettlement -> + ( { model | contractModel = first updatedContractMsg }, second updatedContractMsg ) + + LoadAwards awards -> + ( { model | contractModel = first updatedContractMsg }, second updatedContractMsg ) + + ProposeSettlement partyModel -> + ( { model | contractModel = first updatedContractMsg }, second updatedContractMsg ) + + AcceptSettlement partyModel -> + ( { model | contractModel = first updatedContractMsg }, second updatedContractMsg ) + + LoadAllEvents -> + ( { model | contractModel = first updatedContractMsg }, second updatedContractMsg ) + + LoadExecutionStartedEvent ( blockNumber, txHash, caller, totalDeposits ) -> + ( { model | contractModel = first updatedContractMsg }, second updatedContractMsg ) + + LoadSettlementProposedEvent ( blockNumber, txHash, proposingParty, awardPartyA, awardPartyB ) -> + ( { model | contractModel = first updatedContractMsg }, second updatedContractMsg ) + + LoadDisputeResolvedEvent ( blockNumber, txHash, awardPartyA, awardPartyB ) -> + ( { model | contractModel = first updatedContractMsg }, second updatedContractMsg ) + + LoadContractDisputedEvent ( disputingParty, activeBrehon ) -> + ( { model | contractModel = first updatedContractMsg }, second updatedContractMsg ) + + LoadAppealPeriodStartedEvent ( startTime, activeBrehon, awardPartyA, awardPartyB ) -> + ( { model | contractModel = first updatedContractMsg }, second updatedContractMsg ) + + LoadAppealRaisedEvent ( appealingParty, activeBrehon ) -> + ( { model | contractModel = first updatedContractMsg }, second updatedContractMsg ) + + LoadSecondAppealRaisedEvent ( appealingParty, activeBrehon ) -> + ( { model | contractModel = first updatedContractMsg }, second updatedContractMsg ) + + LoadFundsClaimed ( claimingParty, amount ) -> + ( { model | contractModel = first updatedContractMsg }, second updatedContractMsg ) + + UpdateTimestamp time -> + ( { model | contractModel = first updatedContractMsg }, second updatedContractMsg ) + + RaiseDispute addr -> + ( { model | contractModel = first updatedContractMsg }, second updatedContractMsg ) + + RaiseAppeal addr -> + ( { model | contractModel = first updatedContractMsg }, second updatedContractMsg ) + + RaiseSecondAppeal addr -> + ( { model | contractModel = first updatedContractMsg }, second updatedContractMsg ) + + Adjudicate brehonModel -> + ( { model | contractModel = first updatedContractMsg }, second updatedContractMsg ) + + WithdrawFunds addr -> + ( { model | contractModel = first updatedContractMsg }, second updatedContractMsg ) + + None -> + ( model, Cmd.none ) -updateContract : Msg -> ContractModel -> (ContractModel, Cmd Msg) +updateContract : Msg -> ContractModel -> ( ContractModel, Cmd Msg ) updateContract msg model = case msg of LoadAccounts accounts -> @@ -182,7 +276,7 @@ updateContract msg model = LoadAppealRaisedEvent ( appealingParty, activeBrehon ) -> ( { model | eventLog = - AppealRaisedEvent + AppealRaisedEvent appealingParty activeBrehon :: model.eventLog @@ -193,7 +287,7 @@ updateContract msg model = LoadSecondAppealRaisedEvent ( appealingParty, activeBrehon ) -> ( { model | eventLog = - SecondAppealRaisedEvent + SecondAppealRaisedEvent appealingParty activeBrehon :: model.eventLog @@ -337,10 +431,10 @@ updateContractInfo contractInfo addr stageInt transactionAmount minimumContractA { contractInfoUpdated | stage = SecondAppealPeriod } 7 -> - { contractInfoUpdated | stage = SecondAppeal} + { contractInfoUpdated | stage = SecondAppeal } 8 -> - { contractInfoUpdated | stage = Completed} + { contractInfoUpdated | stage = Completed } _ -> { contractInfoUpdated | stage = Negotiation } diff --git a/app/elm/View.elm b/app/elm/View.elm index bd3c3ee..c46d51a 100644 --- a/app/elm/View.elm +++ b/app/elm/View.elm @@ -6,40 +6,41 @@ import Html.Events exposing (onClick, onInput) import Time.DateTime as DateTime exposing (toISO8601, fromTimestamp) import Msgs exposing (Msg) import Models exposing (Model, ContractCreatorModel, ContractModel, Address, Event(..), ContractInfo, Settlement, Awards, Wei, PartyModel, BrehonModel, FilePath, AppealLevel(..), Stage(..)) - import UrlParsing exposing (..) view : Model -> Html Msg view model = case model.currentRoute of - Just Create -> - div [ class "main-container lg-h4 md-h4 sm-h4 clearfix" ] - [ contractCreatorView model.creatorModel ] - - Just Contract -> - div [ class "main-container lg-h4 md-h4 sm-h4 clearfix" ] - [ contractDetailView model.contractModel - , div [ class "col col-8" ] - [ div [ class "party-list flex flex-wrap" ] - [ partyView model.contractModel.partyA "images/partyA.png" model.contractModel - , partyView model.contractModel.partyB "images/partyB.png" model.contractModel - ] - , div [ class "brehon-list flex flex-wrap flex-column" ] - [ brehonView model.contractModel.primaryBrehon "images/partyPrimaryBrehon.png" model.contractModel - , brehonView model.contractModel.secondaryBrehon "images/partySecondaryBrehon.png" model.contractModel - , brehonView model.contractModel.tertiaryBrehon "images/partyTertiaryBrehon.png" model.contractModel + Just Create -> + div [ class "main-container lg-h4 md-h4 sm-h4 clearfix" ] + [ contractCreatorView model.creatorModel ] + + Just Contract -> + div [ class "main-container lg-h4 md-h4 sm-h4 clearfix" ] + [ contractDetailView model.contractModel + , div [ class "col col-8" ] + [ div [ class "party-list flex flex-wrap" ] + [ partyView model.contractModel.partyA "images/partyA.png" model.contractModel + , partyView model.contractModel.partyB "images/partyB.png" model.contractModel + ] + , div [ class "brehon-list flex flex-wrap flex-column" ] + [ brehonView model.contractModel.primaryBrehon "images/partyPrimaryBrehon.png" model.contractModel + , brehonView model.contractModel.secondaryBrehon "images/partySecondaryBrehon.png" model.contractModel + , brehonView model.contractModel.tertiaryBrehon "images/partyTertiaryBrehon.png" model.contractModel + ] ] + , div [ class "col col-2 lg-h4 sm-h6" ] [ logView model.contractModel ] ] - , div [ class "col col-2 lg-h4 sm-h6" ] [ logView model.contractModel ] - ] - Nothing -> - div [] [ text "Not found 404" ] + + Nothing -> + div [] [ text "Not found 404" ] contractCreatorView : ContractCreatorModel -> Html Msg contractCreatorView model = - text "contractCreatorView" + text "contractCreatorView" + contractDetailView : ContractModel -> Html Msg contractDetailView model = @@ -179,12 +180,15 @@ canPartyRaiseDispute party contractInfo = canPartyAppeal : PartyModel -> ContractInfo -> Bool canPartyAppeal party contractInfo = (contractInfo.stage - == AppealPeriod) + == AppealPeriod + ) + canPartySecondAppeal : PartyModel -> ContractInfo -> Bool canPartySecondAppeal party contractInfo = (contractInfo.stage - == SecondAppealPeriod) + == SecondAppealPeriod + ) canDepositIntoContract : PartyModel -> ContractInfo -> Bool @@ -232,7 +236,6 @@ partyView party profileImage model = ownerView && canPartySecondAppeal party model.contractInfo - viewClass ownerView cssClass = case ownerView of True -> @@ -329,13 +332,14 @@ appealView addr appealLevel = [ a [ class "btn btn-big btn-primary block center rounded h2 black bg-aqua" , href "#" - , onClick ( - case appealLevel of - First -> - Msgs.RaiseAppeal addr - Second -> - Msgs.RaiseSecondAppeal addr - ) + , onClick + (case appealLevel of + First -> + Msgs.RaiseAppeal addr + + Second -> + Msgs.RaiseSecondAppeal addr + ) ] [ text "Appeal" ] ] @@ -453,15 +457,16 @@ brehonView brehon profileImage model = && canBrehonAdjudicate brehon model.contractInfo brehonClass activeBrehon brehon cssClass = - if activeBrehon == brehon.struct.addr - then cssClass ++ " active-brehon" - else cssClass - + if activeBrehon == brehon.struct.addr then + cssClass ++ " active-brehon" + else + cssClass brehonLabel activeBrehon brehon label = - if activeBrehon == brehon.struct.addr - then "Active " ++ label - else label + if activeBrehon == brehon.struct.addr then + "Active " ++ label + else + label viewClass ownerView cssClass = case ownerView of @@ -478,8 +483,8 @@ brehonView brehon profileImage model = |> class ] [ "Brehon" - |> brehonLabel model.contractInfo.activeBrehon brehon - |> text + |> brehonLabel model.contractInfo.activeBrehon brehon + |> text , div [ class "block p1" ] [ img [ src profileImage ] [] , p [] @@ -510,13 +515,18 @@ brehonView brehon profileImage model = canBrehonAdjudicate : BrehonModel -> ContractInfo -> Bool canBrehonAdjudicate brehon contractInfo = - brehon.struct.addr == contractInfo.activeBrehon && - ((contractInfo.stage - == Dispute) || - (contractInfo.stage - == Appeal) || - (contractInfo.stage - == SecondAppeal)) + brehon.struct.addr + == contractInfo.activeBrehon + && ((contractInfo.stage + == Dispute + ) + || (contractInfo.stage + == Appeal + ) + || (contractInfo.stage + == SecondAppeal + ) + ) adjudicateView : BrehonModel -> Html Msg From e1dcd792666d2c5ea436abe72709c63bab526146 Mon Sep 17 00:00:00 2001 From: Prashant Singh Pawar Date: Sun, 7 May 2017 19:48:00 -0400 Subject: [PATCH 03/13] - Refactored the code for better arrangement in modules --- app/elm/Main.elm | 3 +- app/elm/Update.elm | 376 +----------------- app/elm/UrlParsing.elm | 13 +- app/elm/View.elm | 741 +----------------------------------- app/elm/ViewHelpers.elm | 50 +++ app/elm/contract/Update.elm | 379 ++++++++++++++++++ app/elm/contract/View.elm | 696 +++++++++++++++++++++++++++++++++ 7 files changed, 1141 insertions(+), 1117 deletions(-) create mode 100644 app/elm/ViewHelpers.elm create mode 100644 app/elm/contract/Update.elm create mode 100644 app/elm/contract/View.elm diff --git a/app/elm/Main.elm b/app/elm/Main.elm index d293ddd..75dc717 100644 --- a/app/elm/Main.elm +++ b/app/elm/Main.elm @@ -1,6 +1,5 @@ port module Main exposing (..) -import Html exposing (Html, div, text) import Msgs exposing (Msg) import Models exposing (Model, Party, zeroWei, initContractModel, initContractCreatorModel, Brehon, PartyModel, BrehonModel, ContractInfo, Stage(..)) import Time exposing (every, minute, second) @@ -8,11 +7,11 @@ import View exposing (view) import Update exposing (update) import Web3.BrehonAPI exposing (..) import Commands exposing (..) - import Navigation import UrlParser as Url import UrlParsing exposing (..) + -- MODEL diff --git a/app/elm/Update.elm b/app/elm/Update.elm index 886c5b1..a9a6c17 100644 --- a/app/elm/Update.elm +++ b/app/elm/Update.elm @@ -2,10 +2,8 @@ module Update exposing (..) import Tuple exposing (first, second) import Msgs exposing (..) -import Time.DateTime as DateTime exposing (DateTime, dateTime, zero, addDays, fromISO8601, compare, fromTimestamp) -import Time as Time exposing (Time) +import Contract.Update exposing (updateContract) import Models exposing (Model, ContractCreatorModel, ContractModel, Stage(..), Event(..), ContractInfo, Settlement, Awards, Address, Wei, zeroWei, Parties, PartyModel, Party, Brehons, BrehonModel, Brehon) -import Commands exposing (..) import UrlParser as Url exposing (..) import UrlParsing exposing (route) @@ -124,375 +122,3 @@ update msg model = None -> ( model, Cmd.none ) - - -updateContract : Msg -> ContractModel -> ( ContractModel, Cmd Msg ) -updateContract msg model = - case msg of - LoadAccounts accounts -> - ( setLoadedAddress model (List.head accounts), Cmd.none ) - - LoadContractInfo ( deployedAddr, stage, transactionAmount, minimumContractAmt, appealPeriodInDays, activeBrehon, awards ) -> - ( { model - | contractInfo = updateContractInfo model.contractInfo deployedAddr stage transactionAmount minimumContractAmt appealPeriodInDays model.currentTimestamp activeBrehon awards - } - , updateTimestamp - ) - - LoadAllParties parties -> - ( { model - | partyA = updatePartyModel model.partyA parties.partyA - , partyB = updatePartyModel model.partyB parties.partyB - , totalDeposits = parties.totalDeposits - , depositField = zeroWei - , contractInfo = - getPartiesAcceptance parties - |> updatePartyAcceptance model.contractInfo - } - , Cmd.none - ) - - LoadAllBrehons brehons -> - ( { model - | primaryBrehon = updateBrehonModel model.primaryBrehon brehons.primaryBrehon - , secondaryBrehon = updateBrehonModel model.secondaryBrehon brehons.secondaryBrehon - , tertiaryBrehon = updateBrehonModel model.tertiaryBrehon brehons.tertiaryBrehon - , contractInfo = - getBrehonsAcceptance brehons - |> updateBrehonAcceptance model.contractInfo - } - , Cmd.none - ) - - AcceptContractByParty partyModel -> - ( model, acceptContractByParty partyModel ) - - AcceptContractByBrehon brehonModel -> - ( model, acceptContractByBrehon brehonModel ) - - DepositFieldChanged amount -> - ( { model | depositField = amount }, Cmd.none ) - - DepositFunds partyModel -> - ( model, depositFunds partyModel model.depositField ) - - SettlementPartyAFieldChanged amount -> - ( { model | settlementPartyAField = amount }, Cmd.none ) - - SettlementPartyBFieldChanged amount -> - ( { model | settlementPartyBField = amount }, Cmd.none ) - - StartContract party -> - ( model, startContract party.struct.addr ) - - LoadProposedSettlement proposedSettlement -> - ( { model | contractInfo = updateContractInfoSettlement model.contractInfo proposedSettlement }, Cmd.none ) - - LoadAwards awards -> - ( { model | contractInfo = updateAwards model.contractInfo awards }, Cmd.none ) - - ProposeSettlement party -> - ( model, proposeSettlement party.struct.addr model.settlementPartyAField model.settlementPartyBField ) - - AcceptSettlement party -> - case model.contractInfo.proposedSettlement of - Nothing -> - ( model, Cmd.none ) - - Just settlement -> - ( model - , acceptSettlement - party.struct.addr - settlement.settlementPartyA - settlement.settlementPartyB - ) - - LoadAllEvents -> - ( model, Cmd.none ) - - LoadExecutionStartedEvent ( blockNumber, txHash, caller, totalDeposits ) -> - ( { model - | eventLog = - ExecutionStartedEvent blockNumber - txHash - caller - totalDeposits - :: model.eventLog - } - , Cmd.none - ) - - LoadSettlementProposedEvent ( blockNumber, txHash, proposingParty, awardPartyA, awardPartyB ) -> - ( { model - | eventLog = - SettlementProposedEvent blockNumber - txHash - proposingParty - awardPartyA - awardPartyB - :: model.eventLog - } - , Cmd.none - ) - - LoadDisputeResolvedEvent ( blockNumber, txHash, awardPartyA, awardPartyB ) -> - ( { model - | eventLog = - DisputeResolvedEvent blockNumber - txHash - awardPartyA - awardPartyB - :: model.eventLog - } - , Cmd.none - ) - - LoadContractDisputedEvent ( disputingParty, activeBrehon ) -> - ( { model - | eventLog = - ContractDisputedEvent disputingParty - activeBrehon - :: model.eventLog - } - , Cmd.none - ) - - LoadAppealPeriodStartedEvent ( startTime, activeBrehon, awardPartyA, awardPartyB ) -> - ( { model - | eventLog = - AppealPeriodStartedEvent - (toDateTime startTime) - activeBrehon - awardPartyA - awardPartyB - :: model.eventLog - , primaryBrehon = updateBrehonAwards model.primaryBrehon activeBrehon awardPartyA awardPartyB - , secondaryBrehon = updateBrehonAwards model.secondaryBrehon activeBrehon awardPartyA awardPartyB - , contractInfo = updateAppealPeriodInfo model.contractInfo model.currentTimestamp (toDateTime startTime) - } - , Cmd.none - ) - - LoadAppealRaisedEvent ( appealingParty, activeBrehon ) -> - ( { model - | eventLog = - AppealRaisedEvent - appealingParty - activeBrehon - :: model.eventLog - } - , Cmd.none - ) - - LoadSecondAppealRaisedEvent ( appealingParty, activeBrehon ) -> - ( { model - | eventLog = - SecondAppealRaisedEvent - appealingParty - activeBrehon - :: model.eventLog - } - , Cmd.none - ) - - LoadFundsClaimed ( claimingParty, amount ) -> - ( { model - | eventLog = - FundsClaimedEvent claimingParty - amount - :: model.eventLog - } - , Cmd.none - ) - - UpdateTimestamp time -> - ( { model - | currentTimestamp = time - , contractInfo = updateAppealPeriodInProgress model.contractInfo time - } - , Cmd.none - ) - - Adjudicate brehon -> - ( model, adjudicate brehon.struct.addr model.settlementPartyAField model.settlementPartyBField ) - - WithdrawFunds addr -> - ( model, withdrawFunds addr ) - - RaiseDispute addr -> - ( model, raiseDispute addr ) - - RaiseAppeal addr -> - ( model, raiseAppeal addr ) - - RaiseSecondAppeal addr -> - ( model, raiseSecondAppeal addr ) - - _ -> - ( model, Cmd.none ) - - -getPartiesAcceptance : Parties -> Bool -getPartiesAcceptance parties = - List.all (\p -> p.contractAccepted) - [ parties.partyA - , parties.partyB - ] - - -getBrehonsAcceptance : Brehons -> Bool -getBrehonsAcceptance brehons = - List.all (\b -> b.contractAccepted) - [ brehons.primaryBrehon - , brehons.secondaryBrehon - , brehons.tertiaryBrehon - ] - - -setLoadedAddress : ContractModel -> Maybe Address -> ContractModel -setLoadedAddress model address = - case address of - Nothing -> - model - - Just addr -> - { model | loadedAccount = addr } - - -updatePartyAcceptance : ContractInfo -> Bool -> ContractInfo -updatePartyAcceptance contractInfo partiesAccepted = - { contractInfo | partiesAccepted = partiesAccepted } - - -updateBrehonAcceptance : ContractInfo -> Bool -> ContractInfo -updateBrehonAcceptance contractInfo brehonsAccepted = - { contractInfo | brehonsAccepted = brehonsAccepted } - - -updateContractInfoSettlement : ContractInfo -> Maybe Settlement -> ContractInfo -updateContractInfoSettlement contractInfo settlement = - { contractInfo | proposedSettlement = settlement } - - -updateAwards : ContractInfo -> Maybe Awards -> ContractInfo -updateAwards contractInfo awards = - { contractInfo | awards = awards } - - -updateContractInfo : - ContractInfo - -> Address - -> Int - -> Wei - -> Wei - -> Int - -> Time - -> Address - -> Maybe Awards - -> ContractInfo -updateContractInfo contractInfo addr stageInt transactionAmount minimumContractAmt appealPeriodInDays time activeBrehon awards = - let - appealPeriodEnd = - case contractInfo.appealPeriodStart of - Nothing -> - Nothing - - Just appealPeriodStart -> - Just (addDays appealPeriodInDays appealPeriodStart) - - contractInfoUpdated = - { contractInfo - | deployedAt = addr - , transactionAmount = transactionAmount - , minimumContractAmt = minimumContractAmt - , appealPeriodInDays = appealPeriodInDays - , activeBrehon = activeBrehon - , awards = awards - , appealPeriodEnd = appealPeriodEnd - } - in - case stageInt of - 1 -> - { contractInfoUpdated | stage = Execution } - - 2 -> - { contractInfoUpdated | stage = Dispute } - - 3 -> - { contractInfoUpdated | stage = Resolved } - - 4 -> - { contractInfoUpdated | stage = AppealPeriod } - - 5 -> - { contractInfoUpdated | stage = Appeal } - - 6 -> - { contractInfoUpdated | stage = SecondAppealPeriod } - - 7 -> - { contractInfoUpdated | stage = SecondAppeal } - - 8 -> - { contractInfoUpdated | stage = Completed } - - _ -> - { contractInfoUpdated | stage = Negotiation } - - -updatePartyModel : PartyModel -> Party -> PartyModel -updatePartyModel partyModel party = - { partyModel | struct = party } - - -updateBrehonModel : BrehonModel -> Brehon -> BrehonModel -updateBrehonModel brehonModel brehon = - { brehonModel | struct = brehon } - - -updateBrehonAwards : BrehonModel -> Address -> Wei -> Wei -> BrehonModel -updateBrehonAwards brehonModel activeBrehonAddr awardPartyA awardPartyB = - if brehonModel.struct.addr == activeBrehonAddr then - { brehonModel | awards = Just (Awards awardPartyA awardPartyB) } - else - brehonModel - - -updateAppealPeriodInfo : ContractInfo -> Time -> DateTime -> ContractInfo -updateAppealPeriodInfo contractInfo time appealPeriodStart = - let - appealPeriodEnd = - addDays contractInfo.appealPeriodInDays appealPeriodStart - in - { contractInfo - | appealPeriodStart = Just appealPeriodStart - , appealPeriodEnd = Just appealPeriodEnd - } - - -updateAppealPeriodInProgress : ContractInfo -> Time -> ContractInfo -updateAppealPeriodInProgress contractInfo time = - { contractInfo - | appealPeriodInProgress = - case contractInfo.appealPeriodEnd of - Nothing -> - False - - Just appealPeriodEnd -> - case DateTime.compare appealPeriodEnd (fromTimestamp time) of - LT -> - False - - _ -> - True - } - - -toDateTime : String -> DateTime -toDateTime dateString = - case fromISO8601 dateString of - Err e -> - dateTime zero - - Ok r -> - r diff --git a/app/elm/UrlParsing.elm b/app/elm/UrlParsing.elm index 33d2e9e..78e9c57 100644 --- a/app/elm/UrlParsing.elm +++ b/app/elm/UrlParsing.elm @@ -2,14 +2,15 @@ module UrlParsing exposing (..) import UrlParser as Url exposing (..) + type Route - = Create - | Contract + = Create + | Contract route : Url.Parser (Route -> a) a route = - Url.oneOf - [ Url.map Create top - , Url.map Contract (s "contract") - ] + Url.oneOf + [ Url.map Create (s "create") + , Url.map Contract (s "contract") + ] diff --git a/app/elm/View.elm b/app/elm/View.elm index c46d51a..8b68b16 100644 --- a/app/elm/View.elm +++ b/app/elm/View.elm @@ -1,10 +1,9 @@ module View exposing (..) -import Html exposing (Html, Attribute, a, button, div, ul, li, img, input, label, p, span, i, text) -import Html.Attributes exposing (class, href, src, type_, placeholder) -import Html.Events exposing (onClick, onInput) -import Time.DateTime as DateTime exposing (toISO8601, fromTimestamp) +import Html exposing (Html, div, text) +import Html.Attributes exposing (class) import Msgs exposing (Msg) +import Contract.View exposing (..) import Models exposing (Model, ContractCreatorModel, ContractModel, Address, Event(..), ContractInfo, Settlement, Awards, Wei, PartyModel, BrehonModel, FilePath, AppealLevel(..), Stage(..)) import UrlParsing exposing (..) @@ -13,25 +12,10 @@ view : Model -> Html Msg view model = case model.currentRoute of Just Create -> - div [ class "main-container lg-h4 md-h4 sm-h4 clearfix" ] - [ contractCreatorView model.creatorModel ] + contractCreatorView model.creatorModel Just Contract -> - div [ class "main-container lg-h4 md-h4 sm-h4 clearfix" ] - [ contractDetailView model.contractModel - , div [ class "col col-8" ] - [ div [ class "party-list flex flex-wrap" ] - [ partyView model.contractModel.partyA "images/partyA.png" model.contractModel - , partyView model.contractModel.partyB "images/partyB.png" model.contractModel - ] - , div [ class "brehon-list flex flex-wrap flex-column" ] - [ brehonView model.contractModel.primaryBrehon "images/partyPrimaryBrehon.png" model.contractModel - , brehonView model.contractModel.secondaryBrehon "images/partySecondaryBrehon.png" model.contractModel - , brehonView model.contractModel.tertiaryBrehon "images/partyTertiaryBrehon.png" model.contractModel - ] - ] - , div [ class "col col-2 lg-h4 sm-h6" ] [ logView model.contractModel ] - ] + contractView model.contractModel Nothing -> div [] [ text "Not found 404" ] @@ -39,716 +23,5 @@ view model = contractCreatorView : ContractCreatorModel -> Html Msg contractCreatorView model = - text "contractCreatorView" - - -contractDetailView : ContractModel -> Html Msg -contractDetailView model = - let - showProposedSettlement = - model.contractInfo.stage /= Completed - - showActiveBrehon = - model.contractInfo.stage == Dispute - in - ul [ class "contract-detail sm-h5 p2 col col-2 list-reset" ] - [ li [] - [ text "Contract Deployed At: " - , textAddress model.contractInfo.deployedAt - ] - , li [] - [ text "Current Time: " - , model.currentTimestamp - |> fromTimestamp - |> toISO8601 - |> text - ] - , li [] - [ text "Loaded Account: " - , textAddress model.loadedAccount - ] - , li [] - [ text "Total Deposits: " - , text model.totalDeposits - , text " Wei" - ] - , li [] - [ text "Minimum Amount to start the contract: " - , text model.contractInfo.minimumContractAmt - , text " Wei" - ] - , li [] - [ text "Contract Stage: " - , text (toString model.contractInfo.stage) - ] - , li [] - [ text "Transaction Amount : " - , text model.contractInfo.transactionAmount - ] - , li [] - [ text "Parties Accepted : " - , text (toString model.contractInfo.partiesAccepted) - ] - , li [] - [ text "Brehons Accepted : " - , text (toString model.contractInfo.brehonsAccepted) - ] - , li [] - [ proposedSettlementView model.contractInfo.proposedSettlement - ] - |> conditionalBlock showProposedSettlement - , li [] - [ text "Active Brehon: " - , textAddress model.contractInfo.activeBrehon - ] - |> conditionalBlock showActiveBrehon - , li [] - [ text "Appeal Period Start time: " - , text - (model.contractInfo.appealPeriodStart - |> toJustString toISO8601 - ) - ] - |> justValue model.contractInfo.appealPeriodStart - , li [] - [ text "Appeal Period Duration (days): " - , text (toString model.contractInfo.appealPeriodInDays) - ] - |> justValue model.contractInfo.appealPeriodEnd - , li [] - [ text "Appeal Period End time: " - , text - (model.contractInfo.appealPeriodEnd - |> toJustString toISO8601 - ) - ] - |> justValue model.contractInfo.appealPeriodEnd - , li [] - [ awardsView model.contractInfo.awards - ] - |> justValue model.contractInfo.awards - ] - - -canPartyStartContract : PartyModel -> ContractInfo -> Wei -> Bool -canPartyStartContract party contractInfo totalDeposits = - (contractInfo.partiesAccepted && contractInfo.brehonsAccepted) - && contractInfo.stage - == Negotiation - && party.struct.contractAccepted - && totalDeposits - >= contractInfo.minimumContractAmt - - -canPartyProposeSettlement : PartyModel -> ContractInfo -> Bool -canPartyProposeSettlement party contractInfo = - contractInfo.stage - /= Negotiation - && contractInfo.stage - /= Completed - - -canPartyAcceptSettlement : PartyModel -> ContractInfo -> Bool -canPartyAcceptSettlement party contractInfo = - case contractInfo.proposedSettlement of - Nothing -> - False - - Just settlement -> - settlement.proposingPartyAddr - /= party.struct.addr - && contractInfo.stage - /= Completed - - -canPartyWithdrawFunds : PartyModel -> ContractInfo -> Bool -canPartyWithdrawFunds party contractInfo = - contractInfo.stage - == Completed - || (contractInfo.stage - == AppealPeriod - && not contractInfo.appealPeriodInProgress - ) - - -canPartyRaiseDispute : PartyModel -> ContractInfo -> Bool -canPartyRaiseDispute party contractInfo = - contractInfo.stage - == Execution - - -canPartyAppeal : PartyModel -> ContractInfo -> Bool -canPartyAppeal party contractInfo = - (contractInfo.stage - == AppealPeriod - ) - - -canPartySecondAppeal : PartyModel -> ContractInfo -> Bool -canPartySecondAppeal party contractInfo = - (contractInfo.stage - == SecondAppealPeriod - ) - - -canDepositIntoContract : PartyModel -> ContractInfo -> Bool -canDepositIntoContract party contractInfo = - party.struct.contractAccepted - && contractInfo.stage - /= Completed - - -partyView : PartyModel -> FilePath -> ContractModel -> Html Msg -partyView party profileImage model = - let - ownerView = - model.loadedAccount == party.struct.addr - - canDeposit = - ownerView - && canDepositIntoContract party model.contractInfo - - canStartContract = - ownerView - && canPartyStartContract party model.contractInfo model.totalDeposits - - canProposeSettlement = - ownerView - && canPartyProposeSettlement party model.contractInfo - - canAcceptSettlement = - ownerView - && canPartyAcceptSettlement party model.contractInfo - - canWithdrawFunds = - ownerView - && canPartyWithdrawFunds party model.contractInfo - - canRaiseDispute = - ownerView - && canPartyRaiseDispute party model.contractInfo - - canAppeal = - ownerView - && canPartyAppeal party model.contractInfo - - canSecondAppeal = - ownerView - && canPartySecondAppeal party model.contractInfo - - viewClass ownerView cssClass = - case ownerView of - True -> - cssClass ++ " white bg-maroon border-gray" - - False -> - cssClass - in - div - [ "party-view mx-auto max-width-1 border rounded m1 p2" - |> viewClass ownerView - |> class - ] - [ text "Party" - , div [ class "block p1" ] - [ img [ src profileImage ] [] - , text "Address: " - , textAddress party.struct.addr - ] - , div [ class "block p1" ] - [ contractAcceptanceView party.struct.contractAccepted ownerView (Msgs.AcceptContractByParty party) - ] - , div [ class "deposit-block block my1 p1" ] - [ div [ class "my1" ] - [ text "Deposit: " - , text party.struct.deposit - , text " Wei" - ] - , depositView party - ] - |> conditionalBlock canDeposit - , div - [ class "block my1 p1" ] - [ startContractView party - ] - |> conditionalBlock canStartContract - , div - [ class "block my2 p1 border" ] - [ label [ class "label label-title bg-maroon h4" ] [ text "Settlement" ] - , proposeSettlementView party - ] - |> conditionalBlock canProposeSettlement - , div - [ class "block my2 p1 border" ] - [ acceptSettlementView party model.contractInfo.proposedSettlement - ] - |> conditionalBlock canAcceptSettlement - , div - [ class "block my1 p1" ] - [ withdrawFundsView party.struct.addr ] - |> conditionalBlock canWithdrawFunds - , div - [ class "block my1 p1" ] - [ raiseDisputeView party.struct.addr ] - |> conditionalBlock canRaiseDispute - , div - [ class "block my1 p1" ] - [ appealView party.struct.addr First ] - |> conditionalBlock canAppeal - , div - [ class "block my1 p1" ] - [ appealView party.struct.addr Second ] - |> conditionalBlock canSecondAppeal - ] - - -withdrawFundsView : Address -> Html Msg -withdrawFundsView addr = - div [ class "withdraw-funds" ] - [ a - [ class "btn btn-big btn-primary block center rounded h2 black bg-yellow" - , href "#" - , onClick (Msgs.WithdrawFunds addr) - ] - [ text "Withdraw Funds" ] - ] - - -raiseDisputeView : Address -> Html Msg -raiseDisputeView addr = - div [ class "raise-dispute" ] - [ a - [ class "btn btn-big btn-primary block center rounded h2 white bg-red" - , href "#" - , onClick (Msgs.RaiseDispute addr) - ] - [ text "Raise Dispute" ] - ] - - -appealView : Address -> AppealLevel -> Html Msg -appealView addr appealLevel = - div [ class "appeal" ] - [ a - [ class "btn btn-big btn-primary block center rounded h2 black bg-aqua" - , href "#" - , onClick - (case appealLevel of - First -> - Msgs.RaiseAppeal addr - - Second -> - Msgs.RaiseSecondAppeal addr - ) - ] - [ text "Appeal" ] - ] - - -ctaButton : String -> String -> Msg -> Html Msg -ctaButton label cssClass msg = - a - [ class ("btn btn-big btn-primary block center rounded h2 " ++ cssClass) - , href "#" - , onClick msg - ] - [ text label ] - - -proposeSettlementView : PartyModel -> Html Msg -proposeSettlementView party = - div [ class "propose-settlement" ] - [ label [ class "label" ] [ text "Award for Party A" ] - , input - [ class "input" - , placeholder "0 Wei" - , onInput Msgs.SettlementPartyAFieldChanged - ] - [] - , label [ class "label" ] [ text "Award for Party B" ] - , input - [ class "input" - , placeholder "0 wei" - , onInput Msgs.SettlementPartyBFieldChanged - ] - [] - , button - [ class "btn btn-primary" - , onClick (Msgs.ProposeSettlement party) - ] - [ text "Propose Settlement" ] - ] - - -acceptSettlementView : PartyModel -> Maybe Settlement -> Html Msg -acceptSettlementView party proposedSettlement = - case proposedSettlement of - Nothing -> - div [] [] - - Just settlement -> - div [ class "accept-settlement" ] - [ label [ class "label h4" ] - [ text "Award for Party A: " - , text settlement.settlementPartyA - ] - , label [ class "label h4" ] - [ text "Award for Party B: " - , text settlement.settlementPartyB - ] - , button - [ class "btn btn-primary" - , onClick (Msgs.AcceptSettlement party) - ] - [ text "Accept Settlement" ] - ] - - -proposedSettlementView : Maybe Settlement -> Html Msg -proposedSettlementView proposedSettlement = - case proposedSettlement of - Nothing -> - div [] [] - - Just settlement -> - div [] - [ div [] - [ text "Proposing Party: " - , textAddress settlement.proposingPartyAddr - ] - , div [] - [ text "Award Party A: " - , text settlement.settlementPartyA - ] - , div [] - [ text "Award Party B: " - , text settlement.settlementPartyB - ] - ] - - -awardsView : Maybe Awards -> Html Msg -awardsView awards = - case awards of - Nothing -> - div [] [] - - Just awards -> - div [] - [ div [] - [ text "Award Party A: " - , text awards.awardPartyA - ] - , div [] - [ text "Award Party B: " - , text awards.awardPartyB - ] - ] - - -brehonView : BrehonModel -> FilePath -> ContractModel -> Html Msg -brehonView brehon profileImage model = - let - ownerView = - model.loadedAccount == brehon.struct.addr - - canAdjudicate = - ownerView - && canBrehonAdjudicate brehon model.contractInfo - - brehonClass activeBrehon brehon cssClass = - if activeBrehon == brehon.struct.addr then - cssClass ++ " active-brehon" - else - cssClass - - brehonLabel activeBrehon brehon label = - if activeBrehon == brehon.struct.addr then - "Active " ++ label - else - label - - viewClass ownerView cssClass = - case ownerView of - True -> - cssClass ++ " owner white bg-maroon border-gray" - - False -> - cssClass - in - div - [ "brehon-view mx-auto max-width-1 border rounded m1 p2" - |> viewClass ownerView - |> brehonClass model.contractInfo.activeBrehon brehon - |> class - ] - [ "Brehon" - |> brehonLabel model.contractInfo.activeBrehon brehon - |> text - , div [ class "block p1" ] - [ img [ src profileImage ] [] - , p [] - [ text "Address: " - , textAddress brehon.struct.addr - ] - , p [] - [ text "Fixed Fee: " - , text brehon.struct.fixedFee - ] - , p [] - [ text "Dispute Fee: " - , text brehon.struct.disputeFee - ] - ] - , div - [ class "block my1 p1" ] - [ contractAcceptanceView brehon.struct.contractAccepted ownerView (Msgs.AcceptContractByBrehon brehon) ] - , div - [ class "block my1 p1" ] - [ adjudicateView brehon ] - |> conditionalBlock canAdjudicate - , div - [ class "block my1 p1" ] - [ awardsView brehon.awards ] - ] - - -canBrehonAdjudicate : BrehonModel -> ContractInfo -> Bool -canBrehonAdjudicate brehon contractInfo = - brehon.struct.addr - == contractInfo.activeBrehon - && ((contractInfo.stage - == Dispute - ) - || (contractInfo.stage - == Appeal - ) - || (contractInfo.stage - == SecondAppeal - ) - ) - - -adjudicateView : BrehonModel -> Html Msg -adjudicateView brehon = - div [ class "adjudicate" ] - [ label [ class "label" ] [ text "Award for Party A" ] - , input - [ class "input" - , placeholder "0 Wei" - , onInput Msgs.SettlementPartyAFieldChanged - ] - [] - , label [ class "label" ] [ text "Award for Party B" ] - , input - [ class "input" - , placeholder "0 wei" - , onInput Msgs.SettlementPartyBFieldChanged - ] - [] - , button - [ class "btn btn-primary" - , onClick (Msgs.Adjudicate brehon) - ] - [ text "Adjudicate" ] - ] - - -startContractView : PartyModel -> Html Msg -startContractView party = - a - [ class "btn btn-big btn-primary block center rounded h2 black bg-yellow" - , href "#" - , onClick (Msgs.StartContract party) - ] - [ text "Start Contract" ] - - -depositView : PartyModel -> Html Msg -depositView party = - div [ class "deposit-funds my1 clearfix flex" ] - [ input - [ class "input mb0 mr2" - , placeholder "0 Wei" - , type_ "number" - , onInput Msgs.DepositFieldChanged - ] - [] - , a - [ class "btn center rounded white bg-olive" - , href "#" - , onClick (Msgs.DepositFunds party) - ] - [ text "Deposit" ] - ] - - -contractAcceptanceView : Bool -> Bool -> Msg -> Html Msg -contractAcceptanceView isContractAccepted ownerView messageDispatch = - case isContractAccepted of - True -> - p [] - [ i [ class "fa fa-check-circle mr1 green" ] [] - , text "Contract Accepted" - ] - - False -> - if ownerView then - div [ class "fit" ] - [ button - [ class "btn btn-primary btn-big block mx-auto" - , type_ "button" - , onClick (messageDispatch) - ] - [ text "Accept Contract" ] - ] - else - p [] - [ i [ class "fa fa-minus-square mr1 red" ] [] - , text "Contract Not Accepted" - ] - - -logView : ContractModel -> Html Msg -logView model = - ul [ class "list-reset" ] - (model.eventLog - |> List.map singleLogView - ) - - -singleLogView : Event -> Html Msg -singleLogView event = - case event of - ExecutionStartedEvent blockNumber txHash caller totalDeposits -> - li [ class "mb2" ] - [ i [ class "fa fa-paper-plane mr1" ] [] - , text "Contract started by " - , textAddress caller - , text " with a total deposit of " - , text totalDeposits - ] - - SettlementProposedEvent blockNumber txHash proposingParty awardPartyA awardPartyB -> - li [ class "mb2" ] - [ i [ class "fa fa-money mr1" ] [] - , text "Settlement proposed by " - , textAddress proposingParty - , text " with an award of " - , text awardPartyA - , text " for Party A and " - , text awardPartyB - , text " for Party B" - ] - - DisputeResolvedEvent blockNumber txHash awardPartyA awardPartyB -> - li [ class "mb2" ] - [ i [ class "fa fa-hand-peace-o mr1" ] [] - , text "Resolution reached " - , text " with an award of " - , text awardPartyA - , text " for Party A and " - , text awardPartyB - , text " for Party B" - ] - - ContractDisputedEvent disputingParty activeBrehon -> - li [ class "mb2" ] - [ i [ class "fa fa-fire mr1" ] [] - , text "Dispute raised " - , text " by " - , textAddress disputingParty - , text ". Brehon " - , textAddress activeBrehon - , text " is presiding." - ] - - AppealPeriodStartedEvent startTime activeBrehon awardPartyA awardPartyB -> - li [ class "mb2" ] - [ i [ class "fa fa-gavel mr1" ] [] - , text "Brehon " - , textAddress activeBrehon - , text " provided a judgment by awarding " - , text awardPartyA - , text " to partyA and " - , text awardPartyB - , text " to partyB at " - , text (toISO8601 startTime) - ] - - AppealRaisedEvent appealingParty activeBrehon -> - li [ class "mb2" ] - [ i [ class "fa fa-fire mr1" ] [] - , text "Appeal raised " - , text " by " - , textAddress appealingParty - , text ". Brehon " - , textAddress activeBrehon - , text " is presiding." - ] - - SecondAppealRaisedEvent appealingParty activeBrehon -> - li [ class "mb2" ] - [ i [ class "fa fa-fire mr1" ] [] - , i [ class "fa fa-fire mr1" ] [] - , text "Second Appeal raised " - , text " by " - , textAddress appealingParty - , text ". Brehon " - , textAddress activeBrehon - , text " is presiding." - ] - - FundsClaimedEvent claimingParty amount -> - li [ class "mb2" ] - [ i [ class "fa fa-money mr1" ] [] - , text "Funds claimed " - , text " by " - , textAddress claimingParty - , text " in the amount of " - , text amount - ] - - -textAddress : Address -> Html Msg -textAddress address = - case address of - Nothing -> - span [ class "" ] - [ text "" - ] - - Just val -> - span [ class "address char-10" ] - [ text val - ] - - -conditionalBlock : Bool -> Html Msg -> Html Msg -conditionalBlock flag htmlEl = - case flag of - True -> - htmlEl - - False -> - text "" - - -justValue : Maybe a -> Html Msg -> Html Msg -justValue a htmlEl = - case a of - Nothing -> - text "" - - Just a -> - htmlEl - - -toJustString : (a -> String) -> Maybe a -> String -toJustString fn a = - case a of - Nothing -> - "" - - Just a -> - fn a + div [ class "main-container lg-h4 md-h4 sm-h4 clearfix" ] + [ text "contractCreatorView" ] diff --git a/app/elm/ViewHelpers.elm b/app/elm/ViewHelpers.elm new file mode 100644 index 0000000..11f2f0a --- /dev/null +++ b/app/elm/ViewHelpers.elm @@ -0,0 +1,50 @@ +module ViewHelpers exposing (..) + +import Html exposing (Html, text, span) +import Html.Attributes exposing (class) +import Msgs exposing (Msg) +import Models exposing (Address) + + +textAddress : Address -> Html Msg +textAddress address = + case address of + Nothing -> + span [ class "" ] + [ text "" + ] + + Just val -> + span [ class "address char-10" ] + [ text val + ] + + +conditionalBlock : Bool -> Html Msg -> Html Msg +conditionalBlock flag htmlEl = + case flag of + True -> + htmlEl + + False -> + text "" + + +justValue : Maybe a -> Html Msg -> Html Msg +justValue a htmlEl = + case a of + Nothing -> + text "" + + Just a -> + htmlEl + + +toJustString : (a -> String) -> Maybe a -> String +toJustString fn a = + case a of + Nothing -> + "" + + Just a -> + fn a diff --git a/app/elm/contract/Update.elm b/app/elm/contract/Update.elm new file mode 100644 index 0000000..eeb5dad --- /dev/null +++ b/app/elm/contract/Update.elm @@ -0,0 +1,379 @@ +module Contract.Update exposing (..) + +import Msgs exposing (..) +import Models exposing (Model, ContractCreatorModel, ContractModel, Stage(..), Event(..), ContractInfo, Settlement, Awards, Address, Wei, zeroWei, Parties, PartyModel, Party, Brehons, BrehonModel, Brehon) +import Time as Time exposing (Time) +import Time.DateTime as DateTime exposing (DateTime, dateTime, zero, addDays, fromISO8601, compare, fromTimestamp) +import Commands exposing (..) + + +updateContract : Msg -> ContractModel -> ( ContractModel, Cmd Msg ) +updateContract msg model = + case msg of + LoadAccounts accounts -> + ( setLoadedAddress model (List.head accounts), Cmd.none ) + + LoadContractInfo ( deployedAddr, stage, transactionAmount, minimumContractAmt, appealPeriodInDays, activeBrehon, awards ) -> + ( { model + | contractInfo = updateContractInfo model.contractInfo deployedAddr stage transactionAmount minimumContractAmt appealPeriodInDays model.currentTimestamp activeBrehon awards + } + , updateTimestamp + ) + + LoadAllParties parties -> + ( { model + | partyA = updatePartyModel model.partyA parties.partyA + , partyB = updatePartyModel model.partyB parties.partyB + , totalDeposits = parties.totalDeposits + , depositField = zeroWei + , contractInfo = + getPartiesAcceptance parties + |> updatePartyAcceptance model.contractInfo + } + , Cmd.none + ) + + LoadAllBrehons brehons -> + ( { model + | primaryBrehon = updateBrehonModel model.primaryBrehon brehons.primaryBrehon + , secondaryBrehon = updateBrehonModel model.secondaryBrehon brehons.secondaryBrehon + , tertiaryBrehon = updateBrehonModel model.tertiaryBrehon brehons.tertiaryBrehon + , contractInfo = + getBrehonsAcceptance brehons + |> updateBrehonAcceptance model.contractInfo + } + , Cmd.none + ) + + AcceptContractByParty partyModel -> + ( model, acceptContractByParty partyModel ) + + AcceptContractByBrehon brehonModel -> + ( model, acceptContractByBrehon brehonModel ) + + DepositFieldChanged amount -> + ( { model | depositField = amount }, Cmd.none ) + + DepositFunds partyModel -> + ( model, depositFunds partyModel model.depositField ) + + SettlementPartyAFieldChanged amount -> + ( { model | settlementPartyAField = amount }, Cmd.none ) + + SettlementPartyBFieldChanged amount -> + ( { model | settlementPartyBField = amount }, Cmd.none ) + + StartContract party -> + ( model, startContract party.struct.addr ) + + LoadProposedSettlement proposedSettlement -> + ( { model | contractInfo = updateContractInfoSettlement model.contractInfo proposedSettlement }, Cmd.none ) + + LoadAwards awards -> + ( { model | contractInfo = updateAwards model.contractInfo awards }, Cmd.none ) + + ProposeSettlement party -> + ( model, proposeSettlement party.struct.addr model.settlementPartyAField model.settlementPartyBField ) + + AcceptSettlement party -> + case model.contractInfo.proposedSettlement of + Nothing -> + ( model, Cmd.none ) + + Just settlement -> + ( model + , acceptSettlement + party.struct.addr + settlement.settlementPartyA + settlement.settlementPartyB + ) + + LoadAllEvents -> + ( model, Cmd.none ) + + LoadExecutionStartedEvent ( blockNumber, txHash, caller, totalDeposits ) -> + ( { model + | eventLog = + ExecutionStartedEvent blockNumber + txHash + caller + totalDeposits + :: model.eventLog + } + , Cmd.none + ) + + LoadSettlementProposedEvent ( blockNumber, txHash, proposingParty, awardPartyA, awardPartyB ) -> + ( { model + | eventLog = + SettlementProposedEvent blockNumber + txHash + proposingParty + awardPartyA + awardPartyB + :: model.eventLog + } + , Cmd.none + ) + + LoadDisputeResolvedEvent ( blockNumber, txHash, awardPartyA, awardPartyB ) -> + ( { model + | eventLog = + DisputeResolvedEvent blockNumber + txHash + awardPartyA + awardPartyB + :: model.eventLog + } + , Cmd.none + ) + + LoadContractDisputedEvent ( disputingParty, activeBrehon ) -> + ( { model + | eventLog = + ContractDisputedEvent disputingParty + activeBrehon + :: model.eventLog + } + , Cmd.none + ) + + LoadAppealPeriodStartedEvent ( startTime, activeBrehon, awardPartyA, awardPartyB ) -> + ( { model + | eventLog = + AppealPeriodStartedEvent + (toDateTime startTime) + activeBrehon + awardPartyA + awardPartyB + :: model.eventLog + , primaryBrehon = updateBrehonAwards model.primaryBrehon activeBrehon awardPartyA awardPartyB + , secondaryBrehon = updateBrehonAwards model.secondaryBrehon activeBrehon awardPartyA awardPartyB + , contractInfo = updateAppealPeriodInfo model.contractInfo model.currentTimestamp (toDateTime startTime) + } + , Cmd.none + ) + + LoadAppealRaisedEvent ( appealingParty, activeBrehon ) -> + ( { model + | eventLog = + AppealRaisedEvent + appealingParty + activeBrehon + :: model.eventLog + } + , Cmd.none + ) + + LoadSecondAppealRaisedEvent ( appealingParty, activeBrehon ) -> + ( { model + | eventLog = + SecondAppealRaisedEvent + appealingParty + activeBrehon + :: model.eventLog + } + , Cmd.none + ) + + LoadFundsClaimed ( claimingParty, amount ) -> + ( { model + | eventLog = + FundsClaimedEvent claimingParty + amount + :: model.eventLog + } + , Cmd.none + ) + + UpdateTimestamp time -> + ( { model + | currentTimestamp = time + , contractInfo = updateAppealPeriodInProgress model.contractInfo time + } + , Cmd.none + ) + + Adjudicate brehon -> + ( model, adjudicate brehon.struct.addr model.settlementPartyAField model.settlementPartyBField ) + + WithdrawFunds addr -> + ( model, withdrawFunds addr ) + + RaiseDispute addr -> + ( model, raiseDispute addr ) + + RaiseAppeal addr -> + ( model, raiseAppeal addr ) + + RaiseSecondAppeal addr -> + ( model, raiseSecondAppeal addr ) + + _ -> + ( model, Cmd.none ) + + +getPartiesAcceptance : Parties -> Bool +getPartiesAcceptance parties = + List.all (\p -> p.contractAccepted) + [ parties.partyA + , parties.partyB + ] + + +getBrehonsAcceptance : Brehons -> Bool +getBrehonsAcceptance brehons = + List.all (\b -> b.contractAccepted) + [ brehons.primaryBrehon + , brehons.secondaryBrehon + , brehons.tertiaryBrehon + ] + + +setLoadedAddress : ContractModel -> Maybe Address -> ContractModel +setLoadedAddress model address = + case address of + Nothing -> + model + + Just addr -> + { model | loadedAccount = addr } + + +updatePartyAcceptance : ContractInfo -> Bool -> ContractInfo +updatePartyAcceptance contractInfo partiesAccepted = + { contractInfo | partiesAccepted = partiesAccepted } + + +updateBrehonAcceptance : ContractInfo -> Bool -> ContractInfo +updateBrehonAcceptance contractInfo brehonsAccepted = + { contractInfo | brehonsAccepted = brehonsAccepted } + + +updateContractInfoSettlement : ContractInfo -> Maybe Settlement -> ContractInfo +updateContractInfoSettlement contractInfo settlement = + { contractInfo | proposedSettlement = settlement } + + +updateAwards : ContractInfo -> Maybe Awards -> ContractInfo +updateAwards contractInfo awards = + { contractInfo | awards = awards } + + +updateContractInfo : + ContractInfo + -> Address + -> Int + -> Wei + -> Wei + -> Int + -> Time + -> Address + -> Maybe Awards + -> ContractInfo +updateContractInfo contractInfo addr stageInt transactionAmount minimumContractAmt appealPeriodInDays time activeBrehon awards = + let + appealPeriodEnd = + case contractInfo.appealPeriodStart of + Nothing -> + Nothing + + Just appealPeriodStart -> + Just (addDays appealPeriodInDays appealPeriodStart) + + contractInfoUpdated = + { contractInfo + | deployedAt = addr + , transactionAmount = transactionAmount + , minimumContractAmt = minimumContractAmt + , appealPeriodInDays = appealPeriodInDays + , activeBrehon = activeBrehon + , awards = awards + , appealPeriodEnd = appealPeriodEnd + } + in + case stageInt of + 1 -> + { contractInfoUpdated | stage = Execution } + + 2 -> + { contractInfoUpdated | stage = Dispute } + + 3 -> + { contractInfoUpdated | stage = Resolved } + + 4 -> + { contractInfoUpdated | stage = AppealPeriod } + + 5 -> + { contractInfoUpdated | stage = Appeal } + + 6 -> + { contractInfoUpdated | stage = SecondAppealPeriod } + + 7 -> + { contractInfoUpdated | stage = SecondAppeal } + + 8 -> + { contractInfoUpdated | stage = Completed } + + _ -> + { contractInfoUpdated | stage = Negotiation } + + +updatePartyModel : PartyModel -> Party -> PartyModel +updatePartyModel partyModel party = + { partyModel | struct = party } + + +updateBrehonModel : BrehonModel -> Brehon -> BrehonModel +updateBrehonModel brehonModel brehon = + { brehonModel | struct = brehon } + + +updateBrehonAwards : BrehonModel -> Address -> Wei -> Wei -> BrehonModel +updateBrehonAwards brehonModel activeBrehonAddr awardPartyA awardPartyB = + if brehonModel.struct.addr == activeBrehonAddr then + { brehonModel | awards = Just (Awards awardPartyA awardPartyB) } + else + brehonModel + + +updateAppealPeriodInfo : ContractInfo -> Time -> DateTime -> ContractInfo +updateAppealPeriodInfo contractInfo time appealPeriodStart = + let + appealPeriodEnd = + addDays contractInfo.appealPeriodInDays appealPeriodStart + in + { contractInfo + | appealPeriodStart = Just appealPeriodStart + , appealPeriodEnd = Just appealPeriodEnd + } + + +updateAppealPeriodInProgress : ContractInfo -> Time -> ContractInfo +updateAppealPeriodInProgress contractInfo time = + { contractInfo + | appealPeriodInProgress = + case contractInfo.appealPeriodEnd of + Nothing -> + False + + Just appealPeriodEnd -> + case DateTime.compare appealPeriodEnd (fromTimestamp time) of + LT -> + False + + _ -> + True + } + + +toDateTime : String -> DateTime +toDateTime dateString = + case fromISO8601 dateString of + Err e -> + dateTime zero + + Ok r -> + r diff --git a/app/elm/contract/View.elm b/app/elm/contract/View.elm new file mode 100644 index 0000000..2bb2e57 --- /dev/null +++ b/app/elm/contract/View.elm @@ -0,0 +1,696 @@ +module Contract.View exposing (..) + +import ViewHelpers exposing (..) +import Html exposing (Html, Attribute, a, button, div, ul, li, img, input, label, p, span, i, text) +import Html.Attributes exposing (class, href, src, type_, placeholder) +import Html.Events exposing (onClick, onInput) +import Time.DateTime as DateTime exposing (toISO8601, fromTimestamp) +import Msgs exposing (Msg) +import Models exposing (Model, ContractCreatorModel, ContractModel, Address, Event(..), ContractInfo, Settlement, Awards, Wei, PartyModel, BrehonModel, FilePath, AppealLevel(..), Stage(..)) + + +contractView : ContractModel -> Html Msg +contractView model = + div [ class "main-container lg-h4 md-h4 sm-h4 clearfix" ] + [ contractDetailView model + , div [ class "col col-8" ] + [ div [ class "party-list flex flex-wrap" ] + [ partyView model.partyA "images/partyA.png" model + , partyView model.partyB "images/partyB.png" model + ] + , div [ class "brehon-list flex flex-wrap flex-column" ] + [ brehonView model.primaryBrehon "images/partyPrimaryBrehon.png" model + , brehonView model.secondaryBrehon "images/partySecondaryBrehon.png" model + , brehonView model.tertiaryBrehon "images/partyTertiaryBrehon.png" model + ] + ] + , div [ class "col col-2 lg-h4 sm-h6" ] [ logView model ] + ] + + +contractDetailView : ContractModel -> Html Msg +contractDetailView model = + let + showProposedSettlement = + model.contractInfo.stage /= Completed + + showActiveBrehon = + model.contractInfo.stage == Dispute + in + ul [ class "contract-detail sm-h5 p2 col col-2 list-reset" ] + [ li [] + [ text "Contract Deployed At: " + , textAddress model.contractInfo.deployedAt + ] + , li [] + [ text "Current Time: " + , model.currentTimestamp + |> fromTimestamp + |> toISO8601 + |> text + ] + , li [] + [ text "Loaded Account: " + , textAddress model.loadedAccount + ] + , li [] + [ text "Total Deposits: " + , text model.totalDeposits + , text " Wei" + ] + , li [] + [ text "Minimum Amount to start the contract: " + , text model.contractInfo.minimumContractAmt + , text " Wei" + ] + , li [] + [ text "Contract Stage: " + , text (toString model.contractInfo.stage) + ] + , li [] + [ text "Transaction Amount : " + , text model.contractInfo.transactionAmount + ] + , li [] + [ text "Parties Accepted : " + , text (toString model.contractInfo.partiesAccepted) + ] + , li [] + [ text "Brehons Accepted : " + , text (toString model.contractInfo.brehonsAccepted) + ] + , li [] + [ proposedSettlementView model.contractInfo.proposedSettlement + ] + |> conditionalBlock showProposedSettlement + , li [] + [ text "Active Brehon: " + , textAddress model.contractInfo.activeBrehon + ] + |> conditionalBlock showActiveBrehon + , li [] + [ text "Appeal Period Start time: " + , text + (model.contractInfo.appealPeriodStart + |> toJustString toISO8601 + ) + ] + |> justValue model.contractInfo.appealPeriodStart + , li [] + [ text "Appeal Period Duration (days): " + , text (toString model.contractInfo.appealPeriodInDays) + ] + |> justValue model.contractInfo.appealPeriodEnd + , li [] + [ text "Appeal Period End time: " + , text + (model.contractInfo.appealPeriodEnd + |> toJustString toISO8601 + ) + ] + |> justValue model.contractInfo.appealPeriodEnd + , li [] + [ awardsView model.contractInfo.awards + ] + |> justValue model.contractInfo.awards + ] + + +canPartyStartContract : PartyModel -> ContractInfo -> Wei -> Bool +canPartyStartContract party contractInfo totalDeposits = + (contractInfo.partiesAccepted && contractInfo.brehonsAccepted) + && contractInfo.stage + == Negotiation + && party.struct.contractAccepted + && totalDeposits + >= contractInfo.minimumContractAmt + + +canPartyProposeSettlement : PartyModel -> ContractInfo -> Bool +canPartyProposeSettlement party contractInfo = + contractInfo.stage + /= Negotiation + && contractInfo.stage + /= Completed + + +canPartyAcceptSettlement : PartyModel -> ContractInfo -> Bool +canPartyAcceptSettlement party contractInfo = + case contractInfo.proposedSettlement of + Nothing -> + False + + Just settlement -> + settlement.proposingPartyAddr + /= party.struct.addr + && contractInfo.stage + /= Completed + + +canPartyWithdrawFunds : PartyModel -> ContractInfo -> Bool +canPartyWithdrawFunds party contractInfo = + contractInfo.stage + == Completed + || (contractInfo.stage + == AppealPeriod + && not contractInfo.appealPeriodInProgress + ) + + +canPartyRaiseDispute : PartyModel -> ContractInfo -> Bool +canPartyRaiseDispute party contractInfo = + contractInfo.stage + == Execution + + +canPartyAppeal : PartyModel -> ContractInfo -> Bool +canPartyAppeal party contractInfo = + (contractInfo.stage + == AppealPeriod + ) + + +canPartySecondAppeal : PartyModel -> ContractInfo -> Bool +canPartySecondAppeal party contractInfo = + (contractInfo.stage + == SecondAppealPeriod + ) + + +canDepositIntoContract : PartyModel -> ContractInfo -> Bool +canDepositIntoContract party contractInfo = + party.struct.contractAccepted + && contractInfo.stage + /= Completed + + +partyView : PartyModel -> FilePath -> ContractModel -> Html Msg +partyView party profileImage model = + let + ownerView = + model.loadedAccount == party.struct.addr + + canDeposit = + ownerView + && canDepositIntoContract party model.contractInfo + + canStartContract = + ownerView + && canPartyStartContract party model.contractInfo model.totalDeposits + + canProposeSettlement = + ownerView + && canPartyProposeSettlement party model.contractInfo + + canAcceptSettlement = + ownerView + && canPartyAcceptSettlement party model.contractInfo + + canWithdrawFunds = + ownerView + && canPartyWithdrawFunds party model.contractInfo + + canRaiseDispute = + ownerView + && canPartyRaiseDispute party model.contractInfo + + canAppeal = + ownerView + && canPartyAppeal party model.contractInfo + + canSecondAppeal = + ownerView + && canPartySecondAppeal party model.contractInfo + + viewClass ownerView cssClass = + case ownerView of + True -> + cssClass ++ " white bg-maroon border-gray" + + False -> + cssClass + in + div + [ "party-view mx-auto max-width-1 border rounded m1 p2" + |> viewClass ownerView + |> class + ] + [ text "Party" + , div [ class "block p1" ] + [ img [ src profileImage ] [] + , text "Address: " + , textAddress party.struct.addr + ] + , div [ class "block p1" ] + [ contractAcceptanceView party.struct.contractAccepted ownerView (Msgs.AcceptContractByParty party) + ] + , div [ class "deposit-block block my1 p1" ] + [ div [ class "my1" ] + [ text "Deposit: " + , text party.struct.deposit + , text " Wei" + ] + , depositView party + ] + |> conditionalBlock canDeposit + , div + [ class "block my1 p1" ] + [ startContractView party + ] + |> conditionalBlock canStartContract + , div + [ class "block my2 p1 border" ] + [ label [ class "label label-title bg-maroon h4" ] [ text "Settlement" ] + , proposeSettlementView party + ] + |> conditionalBlock canProposeSettlement + , div + [ class "block my2 p1 border" ] + [ acceptSettlementView party model.contractInfo.proposedSettlement + ] + |> conditionalBlock canAcceptSettlement + , div + [ class "block my1 p1" ] + [ withdrawFundsView party.struct.addr ] + |> conditionalBlock canWithdrawFunds + , div + [ class "block my1 p1" ] + [ raiseDisputeView party.struct.addr ] + |> conditionalBlock canRaiseDispute + , div + [ class "block my1 p1" ] + [ appealView party.struct.addr First ] + |> conditionalBlock canAppeal + , div + [ class "block my1 p1" ] + [ appealView party.struct.addr Second ] + |> conditionalBlock canSecondAppeal + ] + + +withdrawFundsView : Address -> Html Msg +withdrawFundsView addr = + div [ class "withdraw-funds" ] + [ a + [ class "btn btn-big btn-primary block center rounded h2 black bg-yellow" + , href "#" + , onClick (Msgs.WithdrawFunds addr) + ] + [ text "Withdraw Funds" ] + ] + + +raiseDisputeView : Address -> Html Msg +raiseDisputeView addr = + div [ class "raise-dispute" ] + [ a + [ class "btn btn-big btn-primary block center rounded h2 white bg-red" + , href "#" + , onClick (Msgs.RaiseDispute addr) + ] + [ text "Raise Dispute" ] + ] + + +appealView : Address -> AppealLevel -> Html Msg +appealView addr appealLevel = + div [ class "appeal" ] + [ a + [ class "btn btn-big btn-primary block center rounded h2 black bg-aqua" + , href "#" + , onClick + (case appealLevel of + First -> + Msgs.RaiseAppeal addr + + Second -> + Msgs.RaiseSecondAppeal addr + ) + ] + [ text "Appeal" ] + ] + + +ctaButton : String -> String -> Msg -> Html Msg +ctaButton label cssClass msg = + a + [ class ("btn btn-big btn-primary block center rounded h2 " ++ cssClass) + , href "#" + , onClick msg + ] + [ text label ] + + +proposeSettlementView : PartyModel -> Html Msg +proposeSettlementView party = + div [ class "propose-settlement" ] + [ label [ class "label" ] [ text "Award for Party A" ] + , input + [ class "input" + , placeholder "0 Wei" + , onInput Msgs.SettlementPartyAFieldChanged + ] + [] + , label [ class "label" ] [ text "Award for Party B" ] + , input + [ class "input" + , placeholder "0 wei" + , onInput Msgs.SettlementPartyBFieldChanged + ] + [] + , button + [ class "btn btn-primary" + , onClick (Msgs.ProposeSettlement party) + ] + [ text "Propose Settlement" ] + ] + + +acceptSettlementView : PartyModel -> Maybe Settlement -> Html Msg +acceptSettlementView party proposedSettlement = + case proposedSettlement of + Nothing -> + div [] [] + + Just settlement -> + div [ class "accept-settlement" ] + [ label [ class "label h4" ] + [ text "Award for Party A: " + , text settlement.settlementPartyA + ] + , label [ class "label h4" ] + [ text "Award for Party B: " + , text settlement.settlementPartyB + ] + , button + [ class "btn btn-primary" + , onClick (Msgs.AcceptSettlement party) + ] + [ text "Accept Settlement" ] + ] + + +proposedSettlementView : Maybe Settlement -> Html Msg +proposedSettlementView proposedSettlement = + case proposedSettlement of + Nothing -> + div [] [] + + Just settlement -> + div [] + [ div [] + [ text "Proposing Party: " + , textAddress settlement.proposingPartyAddr + ] + , div [] + [ text "Award Party A: " + , text settlement.settlementPartyA + ] + , div [] + [ text "Award Party B: " + , text settlement.settlementPartyB + ] + ] + + +awardsView : Maybe Awards -> Html Msg +awardsView awards = + case awards of + Nothing -> + div [] [] + + Just awards -> + div [] + [ div [] + [ text "Award Party A: " + , text awards.awardPartyA + ] + , div [] + [ text "Award Party B: " + , text awards.awardPartyB + ] + ] + + +brehonView : BrehonModel -> FilePath -> ContractModel -> Html Msg +brehonView brehon profileImage model = + let + ownerView = + model.loadedAccount == brehon.struct.addr + + canAdjudicate = + ownerView + && canBrehonAdjudicate brehon model.contractInfo + + brehonClass activeBrehon brehon cssClass = + if activeBrehon == brehon.struct.addr then + cssClass ++ " active-brehon" + else + cssClass + + brehonLabel activeBrehon brehon label = + if activeBrehon == brehon.struct.addr then + "Active " ++ label + else + label + + viewClass ownerView cssClass = + case ownerView of + True -> + cssClass ++ " owner white bg-maroon border-gray" + + False -> + cssClass + in + div + [ "brehon-view mx-auto max-width-1 border rounded m1 p2" + |> viewClass ownerView + |> brehonClass model.contractInfo.activeBrehon brehon + |> class + ] + [ "Brehon" + |> brehonLabel model.contractInfo.activeBrehon brehon + |> text + , div [ class "block p1" ] + [ img [ src profileImage ] [] + , p [] + [ text "Address: " + , textAddress brehon.struct.addr + ] + , p [] + [ text "Fixed Fee: " + , text brehon.struct.fixedFee + ] + , p [] + [ text "Dispute Fee: " + , text brehon.struct.disputeFee + ] + ] + , div + [ class "block my1 p1" ] + [ contractAcceptanceView brehon.struct.contractAccepted ownerView (Msgs.AcceptContractByBrehon brehon) ] + , div + [ class "block my1 p1" ] + [ adjudicateView brehon ] + |> conditionalBlock canAdjudicate + , div + [ class "block my1 p1" ] + [ awardsView brehon.awards ] + ] + + +canBrehonAdjudicate : BrehonModel -> ContractInfo -> Bool +canBrehonAdjudicate brehon contractInfo = + brehon.struct.addr + == contractInfo.activeBrehon + && ((contractInfo.stage + == Dispute + ) + || (contractInfo.stage + == Appeal + ) + || (contractInfo.stage + == SecondAppeal + ) + ) + + +adjudicateView : BrehonModel -> Html Msg +adjudicateView brehon = + div [ class "adjudicate" ] + [ label [ class "label" ] [ text "Award for Party A" ] + , input + [ class "input" + , placeholder "0 Wei" + , onInput Msgs.SettlementPartyAFieldChanged + ] + [] + , label [ class "label" ] [ text "Award for Party B" ] + , input + [ class "input" + , placeholder "0 wei" + , onInput Msgs.SettlementPartyBFieldChanged + ] + [] + , button + [ class "btn btn-primary" + , onClick (Msgs.Adjudicate brehon) + ] + [ text "Adjudicate" ] + ] + + +startContractView : PartyModel -> Html Msg +startContractView party = + a + [ class "btn btn-big btn-primary block center rounded h2 black bg-yellow" + , href "#" + , onClick (Msgs.StartContract party) + ] + [ text "Start Contract" ] + + +depositView : PartyModel -> Html Msg +depositView party = + div [ class "deposit-funds my1 clearfix flex" ] + [ input + [ class "input mb0 mr2" + , placeholder "0 Wei" + , type_ "number" + , onInput Msgs.DepositFieldChanged + ] + [] + , a + [ class "btn center rounded white bg-olive" + , href "#" + , onClick (Msgs.DepositFunds party) + ] + [ text "Deposit" ] + ] + + +contractAcceptanceView : Bool -> Bool -> Msg -> Html Msg +contractAcceptanceView isContractAccepted ownerView messageDispatch = + case isContractAccepted of + True -> + p [] + [ i [ class "fa fa-check-circle mr1 green" ] [] + , text "Contract Accepted" + ] + + False -> + if ownerView then + div [ class "fit" ] + [ button + [ class "btn btn-primary btn-big block mx-auto" + , type_ "button" + , onClick (messageDispatch) + ] + [ text "Accept Contract" ] + ] + else + p [] + [ i [ class "fa fa-minus-square mr1 red" ] [] + , text "Contract Not Accepted" + ] + + +logView : ContractModel -> Html Msg +logView model = + ul [ class "list-reset" ] + (model.eventLog + |> List.map singleLogView + ) + + +singleLogView : Event -> Html Msg +singleLogView event = + case event of + ExecutionStartedEvent blockNumber txHash caller totalDeposits -> + li [ class "mb2" ] + [ i [ class "fa fa-paper-plane mr1" ] [] + , text "Contract started by " + , textAddress caller + , text " with a total deposit of " + , text totalDeposits + ] + + SettlementProposedEvent blockNumber txHash proposingParty awardPartyA awardPartyB -> + li [ class "mb2" ] + [ i [ class "fa fa-money mr1" ] [] + , text "Settlement proposed by " + , textAddress proposingParty + , text " with an award of " + , text awardPartyA + , text " for Party A and " + , text awardPartyB + , text " for Party B" + ] + + DisputeResolvedEvent blockNumber txHash awardPartyA awardPartyB -> + li [ class "mb2" ] + [ i [ class "fa fa-hand-peace-o mr1" ] [] + , text "Resolution reached " + , text " with an award of " + , text awardPartyA + , text " for Party A and " + , text awardPartyB + , text " for Party B" + ] + + ContractDisputedEvent disputingParty activeBrehon -> + li [ class "mb2" ] + [ i [ class "fa fa-fire mr1" ] [] + , text "Dispute raised " + , text " by " + , textAddress disputingParty + , text ". Brehon " + , textAddress activeBrehon + , text " is presiding." + ] + + AppealPeriodStartedEvent startTime activeBrehon awardPartyA awardPartyB -> + li [ class "mb2" ] + [ i [ class "fa fa-gavel mr1" ] [] + , text "Brehon " + , textAddress activeBrehon + , text " provided a judgment by awarding " + , text awardPartyA + , text " to partyA and " + , text awardPartyB + , text " to partyB at " + , text (toISO8601 startTime) + ] + + AppealRaisedEvent appealingParty activeBrehon -> + li [ class "mb2" ] + [ i [ class "fa fa-fire mr1" ] [] + , text "Appeal raised " + , text " by " + , textAddress appealingParty + , text ". Brehon " + , textAddress activeBrehon + , text " is presiding." + ] + + SecondAppealRaisedEvent appealingParty activeBrehon -> + li [ class "mb2" ] + [ i [ class "fa fa-fire mr1" ] [] + , i [ class "fa fa-fire mr1" ] [] + , text "Second Appeal raised " + , text " by " + , textAddress appealingParty + , text ". Brehon " + , textAddress activeBrehon + , text " is presiding." + ] + + FundsClaimedEvent claimingParty amount -> + li [ class "mb2" ] + [ i [ class "fa fa-money mr1" ] [] + , text "Funds claimed " + , text " by " + , textAddress claimingParty + , text " in the amount of " + , text amount + ] From ddfe09dc9bfb509efdbcf2b5f5cd5ccaffa12893 Mon Sep 17 00:00:00 2001 From: Prashant Singh Pawar Date: Mon, 8 May 2017 00:22:40 -0400 Subject: [PATCH 04/13] - Added UI markup for creating a contract --- app/elm/View.elm | 112 +++++++++++++++++++++++++++++++++++++++++++++-- app/index.html | 1 - 2 files changed, 109 insertions(+), 4 deletions(-) diff --git a/app/elm/View.elm b/app/elm/View.elm index 8b68b16..2703960 100644 --- a/app/elm/View.elm +++ b/app/elm/View.elm @@ -1,7 +1,7 @@ module View exposing (..) -import Html exposing (Html, div, text) -import Html.Attributes exposing (class) +import Html exposing (Html, div, text, label, form, input, textarea, button) +import Html.Attributes exposing (class, placeholder, type_, rows, value) import Msgs exposing (Msg) import Contract.View exposing (..) import Models exposing (Model, ContractCreatorModel, ContractModel, Address, Event(..), ContractInfo, Settlement, Awards, Wei, PartyModel, BrehonModel, FilePath, AppealLevel(..), Stage(..)) @@ -24,4 +24,110 @@ view model = contractCreatorView : ContractCreatorModel -> Html Msg contractCreatorView model = div [ class "main-container lg-h4 md-h4 sm-h4 clearfix" ] - [ text "contractCreatorView" ] + [ div [ class "col-4 mx-auto" ] + [ form [ class "contract-creator-form" ] + [ label [ class "label" ] [ text "Party A" ] + , input + [ class "input ethereum-address party-a-addr" + , placeholder "0x00000" + , value "0x90f8bf6a479f320ead074411a4b0e7944ea8c9c1" + ] + [] + , label [ class "label" ] [ text "Party B" ] + , input + [ class "input ethereum-address party-b-addr" + , placeholder "0x00000" + , value "0xffcf8fdee72ac11b5c542428b35eef5769c409f0" + ] + [] + , label [ class "label" ] [ text "Transaction Amount" ] + , input + [ class "input tx-amount" + , type_ "number" + , placeholder "e.g. 1000 Wei" + , value "5000" + ] + [] + , label [ class "label" ] [ text "Terms and Conditions" ] + , textarea + [ class "textarea tx-amount" + , rows 6 + , placeholder "Party A agrees to sell Party B a 1996 Rolex watch for 500 Wei." + , value "Party A agrees to sell Party B a 1996 Rolex watch for 500 Wei." + ] + [] + , div [ class "" ] + [ label [ class "label" ] [ text "Primary Brehon" ] + , input + [ class "input ethereum-address primary-brehon-addr" + , placeholder "0x00000" + , value "0x22d491bde2303f2f43325b2108d26f1eaba1e32b" + ] + [] + , label [ class "label" ] [ text "Fixed Fee" ] + , input + [ class "input ethereum-address primary-brehon-addr" + , placeholder "e.g. 100 Wei" + , value "10" + ] + [] + , label [ class "label" ] [ text "Dispute Fee" ] + , input + [ class "input ethereum-address primary-brehon-addr" + , placeholder "e.g. 100 Wei" + , value "100" + ] + [] + ] + , div [ class "" ] + [ label [ class "label" ] [ text "Secondary Brehon" ] + , input + [ class "input ethereum-address primary-brehon-addr" + , placeholder "0x00000" + , value "0xe11ba2b4d45eaed5996cd0823791e0c93114882d" + ] + [] + , label [ class "label" ] [ text "Fixed Fee" ] + , input + [ class "input ethereum-address primary-brehon-addr" + , placeholder "e.g. 100 Wei" + , value "10" + ] + [] + , label [ class "label" ] [ text "Dispute Fee" ] + , input + [ class "input ethereum-address primary-brehon-addr" + , placeholder "e.g. 100 Wei" + , value "100" + ] + [] + ] + , div [ class "" ] + [ label [ class "label" ] [ text "Tertiary Brehon" ] + , input + [ class "input ethereum-address primary-brehon-addr" + , placeholder "0x00000" + , value "0xd03ea8624c8c5987235048901fb614fdca89b117" + ] + [] + , label [ class "label" ] [ text "Fixed Fee" ] + , input + [ class "input ethereum-address primary-brehon-addr" + , placeholder "e.g. 100 Wei" + , value "10" + ] + [] + , label [ class "label" ] [ text "Dispute Fee" ] + , input + [ class "input ethereum-address primary-brehon-addr" + , placeholder "e.g. 100 Wei" + , value "100" + ] + [] + ] + , button [ class "button" ] + [ text "Create" + ] + ] + ] + ] diff --git a/app/index.html b/app/index.html index 6da53dd..7fa6b77 100644 --- a/app/index.html +++ b/app/index.html @@ -4,7 +4,6 @@ Brehon Contract - Truffle Webpack Demo w/ Frontend -
From 9851071ca5f3da1fd8ace0daf73155554b67e1e7 Mon Sep 17 00:00:00 2001 From: Prashant Singh Pawar Date: Mon, 15 May 2017 20:29:03 -0400 Subject: [PATCH 05/13] - Added btn-primary for create contract button --- app/elm/View.elm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/app/elm/View.elm b/app/elm/View.elm index 2703960..5df8744 100644 --- a/app/elm/View.elm +++ b/app/elm/View.elm @@ -125,7 +125,7 @@ contractCreatorView model = ] [] ] - , button [ class "button" ] + , button [ class "btn btn-primary" ] [ text "Create" ] ] From d1d8bf7c137710648607f47278272d32482be469 Mon Sep 17 00:00:00 2001 From: Prashant Singh Pawar Date: Sat, 3 Jun 2017 21:45:24 -0400 Subject: [PATCH 06/13] - Added Form and default values for deploying the contract --- app/elm/Models.elm | 40 ++++++++++++++++++++++----------------- app/elm/Msgs.elm | 3 ++- app/elm/Update.elm | 8 ++++++++ app/elm/View.elm | 10 ++++++++-- app/elm/create/Update.elm | 14 ++++++++++++++ 5 files changed, 55 insertions(+), 20 deletions(-) create mode 100644 app/elm/create/Update.elm diff --git a/app/elm/Models.elm b/app/elm/Models.elm index 5a17d89..f2bedc8 100644 --- a/app/elm/Models.elm +++ b/app/elm/Models.elm @@ -2,7 +2,6 @@ module Models exposing (..) import Time.DateTime as DateTime exposing (DateTime, dateTime) import Time as Time exposing (Time, now) - import UrlParsing exposing (Route) @@ -10,31 +9,33 @@ zeroWei : Wei zeroWei = "0" + initContractModel : ContractModel initContractModel = - ContractModel - initContractInfo - 0 - [] - Nothing - zeroWei - zeroWei - zeroWei - zeroWei - (PartyModel (Party Nothing zeroWei False)) - (PartyModel (Party Nothing zeroWei False)) - (BrehonModel (Brehon Nothing False zeroWei zeroWei) Nothing) - (BrehonModel (Brehon Nothing False zeroWei zeroWei) Nothing) - (BrehonModel (Brehon Nothing False zeroWei zeroWei) Nothing) + ContractModel + initContractInfo + 0 + [] + Nothing + zeroWei + zeroWei + zeroWei + zeroWei + (PartyModel (Party Nothing zeroWei False)) + (PartyModel (Party Nothing zeroWei False)) + (BrehonModel (Brehon Nothing False zeroWei zeroWei) Nothing) + (BrehonModel (Brehon Nothing False zeroWei zeroWei) Nothing) + (BrehonModel (Brehon Nothing False zeroWei zeroWei) Nothing) initContractInfo : ContractInfo initContractInfo = ContractInfo Nothing Negotiation zeroWei zeroWei False False Nothing Nothing Nothing 0 False Nothing Nothing + initContractCreatorModel : ContractCreatorModel initContractCreatorModel = - ContractCreatorModel "party A" + ContractCreatorModel (Just "0x90f8bf6a479f320ead074411a4b0e7944ea8c9c1") type alias Model = @@ -44,10 +45,12 @@ type alias Model = , contractModel : ContractModel } + type alias ContractCreatorModel = - { partyA : String + { partyA : Address } + type alias ContractModel = { contractInfo : ContractInfo , currentTimestamp : Time @@ -64,6 +67,7 @@ type alias ContractModel = , tertiaryBrehon : BrehonModel } + type alias ContractInfo = { deployedAt : Address , stage : Stage @@ -157,6 +161,7 @@ type Stage | SecondAppeal | Completed + type Event = ExecutionStartedEvent Int Address Address Wei | SettlementProposedEvent Int Address Address Wei Wei @@ -167,6 +172,7 @@ type Event | SecondAppealRaisedEvent Address Address | FundsClaimedEvent Address Wei + type AppealLevel = First | Second diff --git a/app/elm/Msgs.elm b/app/elm/Msgs.elm index 9e9c936..6d3e08a 100644 --- a/app/elm/Msgs.elm +++ b/app/elm/Msgs.elm @@ -14,7 +14,6 @@ import Models , Brehons , Event ) - import Navigation @@ -50,4 +49,6 @@ type Msg | RaiseSecondAppeal Address | Adjudicate BrehonModel | WithdrawFunds Address + -- ContractCreator Msgs + | PartyAAddrChanged String | None diff --git a/app/elm/Update.elm b/app/elm/Update.elm index a9a6c17..2e3b4b2 100644 --- a/app/elm/Update.elm +++ b/app/elm/Update.elm @@ -3,6 +3,7 @@ module Update exposing (..) import Tuple exposing (first, second) import Msgs exposing (..) import Contract.Update exposing (updateContract) +import Create.Update exposing (updateCreateContract) import Models exposing (Model, ContractCreatorModel, ContractModel, Stage(..), Event(..), ContractInfo, Settlement, Awards, Address, Wei, zeroWei, Parties, PartyModel, Party, Brehons, BrehonModel, Brehon) import UrlParser as Url exposing (..) import UrlParsing exposing (route) @@ -13,6 +14,9 @@ update msg model = let updatedContractMsg = updateContract msg model.contractModel + + updateCreateContractMsg = + updateCreateContract msg model.creatorModel in case msg of UrlChange location -> @@ -120,5 +124,9 @@ update msg model = WithdrawFunds addr -> ( { model | contractModel = first updatedContractMsg }, second updatedContractMsg ) + -- ContractCreator Msgs + PartyAAddrChanged addr -> + ( { model | creatorModel = first updateCreateContractMsg }, second updateCreateContractMsg ) + None -> ( model, Cmd.none ) diff --git a/app/elm/View.elm b/app/elm/View.elm index 5df8744..3b9bb1c 100644 --- a/app/elm/View.elm +++ b/app/elm/View.elm @@ -1,7 +1,9 @@ module View exposing (..) +import ViewHelpers exposing (..) import Html exposing (Html, div, text, label, form, input, textarea, button) import Html.Attributes exposing (class, placeholder, type_, rows, value) +import Html.Events exposing (onClick, onInput) import Msgs exposing (Msg) import Contract.View exposing (..) import Models exposing (Model, ContractCreatorModel, ContractModel, Address, Event(..), ContractInfo, Settlement, Awards, Wei, PartyModel, BrehonModel, FilePath, AppealLevel(..), Stage(..)) @@ -29,14 +31,16 @@ contractCreatorView model = [ label [ class "label" ] [ text "Party A" ] , input [ class "input ethereum-address party-a-addr" + , onInput Msgs.PartyAAddrChanged , placeholder "0x00000" - , value "0x90f8bf6a479f320ead074411a4b0e7944ea8c9c1" + , value (toJustString identity model.partyA) ] [] , label [ class "label" ] [ text "Party B" ] , input [ class "input ethereum-address party-b-addr" , placeholder "0x00000" + , onInput Msgs.PartyAAddrChanged , value "0xffcf8fdee72ac11b5c542428b35eef5769c409f0" ] [] @@ -125,7 +129,9 @@ contractCreatorView model = ] [] ] - , button [ class "btn btn-primary" ] + , button + [ class "btn btn-primary" + ] [ text "Create" ] ] diff --git a/app/elm/create/Update.elm b/app/elm/create/Update.elm new file mode 100644 index 0000000..09968d5 --- /dev/null +++ b/app/elm/create/Update.elm @@ -0,0 +1,14 @@ +module Create.Update exposing (..) + +import Msgs exposing (..) +import Models exposing (ContractCreatorModel) + + +updateCreateContract : Msg -> ContractCreatorModel -> ( ContractCreatorModel, Cmd Msg ) +updateCreateContract msg model = + case msg of + PartyAAddrChanged addr -> + ( { model | partyA = Just addr }, Cmd.none ) + + _ -> + ( model, Cmd.none ) From 73eb08902acba18a7018a3154750d1e660c815ee Mon Sep 17 00:00:00 2001 From: Prashant Singh Pawar Date: Sat, 3 Jun 2017 23:41:41 -0400 Subject: [PATCH 07/13] - Added URL param for contacts view --- app/elm/UrlParsing.elm | 4 ++-- app/elm/View.elm | 9 +++++---- 2 files changed, 7 insertions(+), 6 deletions(-) diff --git a/app/elm/UrlParsing.elm b/app/elm/UrlParsing.elm index 78e9c57..dd8ae6e 100644 --- a/app/elm/UrlParsing.elm +++ b/app/elm/UrlParsing.elm @@ -5,12 +5,12 @@ import UrlParser as Url exposing (..) type Route = Create - | Contract + | Contract String route : Url.Parser (Route -> a) a route = Url.oneOf [ Url.map Create (s "create") - , Url.map Contract (s "contract") + , Url.map Contract (s "contract" string) ] diff --git a/app/elm/View.elm b/app/elm/View.elm index 3b9bb1c..b330c06 100644 --- a/app/elm/View.elm +++ b/app/elm/View.elm @@ -1,8 +1,8 @@ module View exposing (..) import ViewHelpers exposing (..) -import Html exposing (Html, div, text, label, form, input, textarea, button) -import Html.Attributes exposing (class, placeholder, type_, rows, value) +import Html exposing (Html, div, text, label, form, input, textarea, button, a) +import Html.Attributes exposing (class, placeholder, type_, rows, value, href) import Html.Events exposing (onClick, onInput) import Msgs exposing (Msg) import Contract.View exposing (..) @@ -16,7 +16,7 @@ view model = Just Create -> contractCreatorView model.creatorModel - Just Contract -> + Just (Contract contractAddr) -> contractView model.contractModel Nothing -> @@ -129,8 +129,9 @@ contractCreatorView model = ] [] ] - , button + , a [ class "btn btn-primary" + , href ("#contract/" ++ toJustString identity model.partyA) ] [ text "Create" ] From c1d59aaa0f96c8e8f39ea590dc6d88e925e33b1a Mon Sep 17 00:00:00 2001 From: Prashant Singh Pawar Date: Sun, 4 Jun 2017 09:34:33 -0400 Subject: [PATCH 08/13] - Added model watching for PartyB address changed and Tx amount changed --- app/elm/Models.elm | 7 ++++++- app/elm/Msgs.elm | 2 ++ app/elm/Update.elm | 6 ++++++ app/elm/View.elm | 7 ++++--- app/elm/create/Update.elm | 6 ++++++ 5 files changed, 24 insertions(+), 4 deletions(-) diff --git a/app/elm/Models.elm b/app/elm/Models.elm index f2bedc8..92a8df8 100644 --- a/app/elm/Models.elm +++ b/app/elm/Models.elm @@ -35,7 +35,10 @@ initContractInfo = initContractCreatorModel : ContractCreatorModel initContractCreatorModel = - ContractCreatorModel (Just "0x90f8bf6a479f320ead074411a4b0e7944ea8c9c1") + ContractCreatorModel + (Just "0x90f8bf6a479f320ead074411a4b0e7944ea8c9c1") + (Just "0xffcf8fdee72ac11b5c542428b35eef5769c409f0") + "500" type alias Model = @@ -48,6 +51,8 @@ type alias Model = type alias ContractCreatorModel = { partyA : Address + , partyB : Address + , transactionAmount : Wei } diff --git a/app/elm/Msgs.elm b/app/elm/Msgs.elm index 6d3e08a..e5e9bfd 100644 --- a/app/elm/Msgs.elm +++ b/app/elm/Msgs.elm @@ -51,4 +51,6 @@ type Msg | WithdrawFunds Address -- ContractCreator Msgs | PartyAAddrChanged String + | PartyBAddrChanged String + | TxAmountChanged Wei | None diff --git a/app/elm/Update.elm b/app/elm/Update.elm index 2e3b4b2..0951800 100644 --- a/app/elm/Update.elm +++ b/app/elm/Update.elm @@ -128,5 +128,11 @@ update msg model = PartyAAddrChanged addr -> ( { model | creatorModel = first updateCreateContractMsg }, second updateCreateContractMsg ) + PartyBAddrChanged addr -> + ( { model | creatorModel = first updateCreateContractMsg }, second updateCreateContractMsg ) + + TxAmountChanged amount -> + ( { model | creatorModel = first updateCreateContractMsg }, second updateCreateContractMsg ) + None -> ( model, Cmd.none ) diff --git a/app/elm/View.elm b/app/elm/View.elm index b330c06..2aa3682 100644 --- a/app/elm/View.elm +++ b/app/elm/View.elm @@ -40,8 +40,8 @@ contractCreatorView model = , input [ class "input ethereum-address party-b-addr" , placeholder "0x00000" - , onInput Msgs.PartyAAddrChanged - , value "0xffcf8fdee72ac11b5c542428b35eef5769c409f0" + , onInput Msgs.PartyBAddrChanged + , value (toJustString identity model.partyB) ] [] , label [ class "label" ] [ text "Transaction Amount" ] @@ -49,7 +49,8 @@ contractCreatorView model = [ class "input tx-amount" , type_ "number" , placeholder "e.g. 1000 Wei" - , value "5000" + , onInput Msgs.TxAmountChanged + , value model.transactionAmount ] [] , label [ class "label" ] [ text "Terms and Conditions" ] diff --git a/app/elm/create/Update.elm b/app/elm/create/Update.elm index 09968d5..3c75a26 100644 --- a/app/elm/create/Update.elm +++ b/app/elm/create/Update.elm @@ -10,5 +10,11 @@ updateCreateContract msg model = PartyAAddrChanged addr -> ( { model | partyA = Just addr }, Cmd.none ) + PartyBAddrChanged addr -> + ( { model | partyB = Just addr }, Cmd.none ) + + TxAmountChanged amount -> + ( { model | transactionAmount = amount }, Cmd.none ) + _ -> ( model, Cmd.none ) From 1b1f4fbd1531dff9ed317c7808b7389ca23abd22 Mon Sep 17 00:00:00 2001 From: Prashant Singh Pawar Date: Sun, 4 Jun 2017 09:35:02 -0400 Subject: [PATCH 09/13] - Added model watching for all attributes of ContractCreatorModel --- app/elm/Models.elm | 20 ++++++++++++++++++++ app/elm/Msgs.elm | 10 ++++++++++ app/elm/Update.elm | 30 ++++++++++++++++++++++++++++++ app/elm/View.elm | 20 +++++++++++++++----- app/elm/create/Update.elm | 30 ++++++++++++++++++++++++++++++ 5 files changed, 105 insertions(+), 5 deletions(-) diff --git a/app/elm/Models.elm b/app/elm/Models.elm index 92a8df8..df8383c 100644 --- a/app/elm/Models.elm +++ b/app/elm/Models.elm @@ -39,6 +39,16 @@ initContractCreatorModel = (Just "0x90f8bf6a479f320ead074411a4b0e7944ea8c9c1") (Just "0xffcf8fdee72ac11b5c542428b35eef5769c409f0") "500" + "Party A agrees to sell Party B a 1996 Rolex watch for 500 Wei." + (Just "0x22d491bde2303f2f43325b2108d26f1eaba1e32b") + "10" + "100" + (Just "0xe11ba2b4d45eaed5996cd0823791e0c93114882d") + "10" + "100" + (Just "0xd03ea8624c8c5987235048901fb614fdca89b117") + "10" + "100" type alias Model = @@ -53,6 +63,16 @@ type alias ContractCreatorModel = { partyA : Address , partyB : Address , transactionAmount : Wei + , termsAndConditions : String + , primaryBrehonAddr : Address + , primaryBrehonFixedFee : Wei + , primaryBrehonDisputeFee : Wei + , secondaryBrehonAddr : Address + , secondaryBrehonFixedFee : Wei + , secondaryBrehonDisputeFee : Wei + , tertiaryBrehonAddr : Address + , tertiaryBrehonFixedFee : Wei + , tertiaryBrehonDisputeFee : Wei } diff --git a/app/elm/Msgs.elm b/app/elm/Msgs.elm index e5e9bfd..9e4c9dd 100644 --- a/app/elm/Msgs.elm +++ b/app/elm/Msgs.elm @@ -53,4 +53,14 @@ type Msg | PartyAAddrChanged String | PartyBAddrChanged String | TxAmountChanged Wei + | TermsChanged String + | PrimaryBrehonAddrChanged String + | PrimaryBrehonFixedFeeChanged Wei + | PrimaryBrehonDisputeFeeChanged Wei + | SecondaryBrehonAddrChanged String + | SecondaryBrehonFixedFeeChanged Wei + | SecondaryBrehonDisputeFeeChanged Wei + | TertiaryBrehonAddrChanged String + | TertiaryBrehonFixedFeeChanged Wei + | TertiaryBrehonDisputeFeeChanged Wei | None diff --git a/app/elm/Update.elm b/app/elm/Update.elm index 0951800..438ad76 100644 --- a/app/elm/Update.elm +++ b/app/elm/Update.elm @@ -134,5 +134,35 @@ update msg model = TxAmountChanged amount -> ( { model | creatorModel = first updateCreateContractMsg }, second updateCreateContractMsg ) + TermsChanged termsAndConditions -> + ( { model | creatorModel = first updateCreateContractMsg }, second updateCreateContractMsg ) + + PrimaryBrehonAddrChanged addr -> + ( { model | creatorModel = first updateCreateContractMsg }, second updateCreateContractMsg ) + + PrimaryBrehonFixedFeeChanged fixedFee -> + ( { model | creatorModel = first updateCreateContractMsg }, second updateCreateContractMsg ) + + PrimaryBrehonDisputeFeeChanged disputeFee -> + ( { model | creatorModel = first updateCreateContractMsg }, second updateCreateContractMsg ) + + SecondaryBrehonAddrChanged addr -> + ( { model | creatorModel = first updateCreateContractMsg }, second updateCreateContractMsg ) + + SecondaryBrehonFixedFeeChanged fixedFee -> + ( { model | creatorModel = first updateCreateContractMsg }, second updateCreateContractMsg ) + + SecondaryBrehonDisputeFeeChanged disputeFee -> + ( { model | creatorModel = first updateCreateContractMsg }, second updateCreateContractMsg ) + + TertiaryBrehonAddrChanged addr -> + ( { model | creatorModel = first updateCreateContractMsg }, second updateCreateContractMsg ) + + TertiaryBrehonFixedFeeChanged fixedFee -> + ( { model | creatorModel = first updateCreateContractMsg }, second updateCreateContractMsg ) + + TertiaryBrehonDisputeFeeChanged disputeFee -> + ( { model | creatorModel = first updateCreateContractMsg }, second updateCreateContractMsg ) + None -> ( model, Cmd.none ) diff --git a/app/elm/View.elm b/app/elm/View.elm index 2aa3682..fe065ff 100644 --- a/app/elm/View.elm +++ b/app/elm/View.elm @@ -6,7 +6,7 @@ import Html.Attributes exposing (class, placeholder, type_, rows, value, href) import Html.Events exposing (onClick, onInput) import Msgs exposing (Msg) import Contract.View exposing (..) -import Models exposing (Model, ContractCreatorModel, ContractModel, Address, Event(..), ContractInfo, Settlement, Awards, Wei, PartyModel, BrehonModel, FilePath, AppealLevel(..), Stage(..)) +import Models exposing (Model, initContractCreatorModel, ContractCreatorModel, ContractModel, Address, Event(..), ContractInfo, Settlement, Awards, Wei, PartyModel, BrehonModel, FilePath, AppealLevel(..), Stage(..)) import UrlParsing exposing (..) @@ -33,15 +33,15 @@ contractCreatorView model = [ class "input ethereum-address party-a-addr" , onInput Msgs.PartyAAddrChanged , placeholder "0x00000" - , value (toJustString identity model.partyA) + , value "0x90f8bf6a479f320ead074411a4b0e7944ea8c9c1" ] [] , label [ class "label" ] [ text "Party B" ] , input [ class "input ethereum-address party-b-addr" - , placeholder "0x00000" , onInput Msgs.PartyBAddrChanged - , value (toJustString identity model.partyB) + , placeholder "0x00000" + , value "0xffcf8fdee72ac11b5c542428b35eef5769c409f0" ] [] , label [ class "label" ] [ text "Transaction Amount" ] @@ -50,7 +50,7 @@ contractCreatorView model = , type_ "number" , placeholder "e.g. 1000 Wei" , onInput Msgs.TxAmountChanged - , value model.transactionAmount + , value "5000" ] [] , label [ class "label" ] [ text "Terms and Conditions" ] @@ -58,6 +58,7 @@ contractCreatorView model = [ class "textarea tx-amount" , rows 6 , placeholder "Party A agrees to sell Party B a 1996 Rolex watch for 500 Wei." + , onInput Msgs.TermsChanged , value "Party A agrees to sell Party B a 1996 Rolex watch for 500 Wei." ] [] @@ -66,6 +67,7 @@ contractCreatorView model = , input [ class "input ethereum-address primary-brehon-addr" , placeholder "0x00000" + , onInput Msgs.PrimaryBrehonAddrChanged , value "0x22d491bde2303f2f43325b2108d26f1eaba1e32b" ] [] @@ -73,6 +75,7 @@ contractCreatorView model = , input [ class "input ethereum-address primary-brehon-addr" , placeholder "e.g. 100 Wei" + , onInput Msgs.PrimaryBrehonFixedFeeChanged , value "10" ] [] @@ -80,6 +83,7 @@ contractCreatorView model = , input [ class "input ethereum-address primary-brehon-addr" , placeholder "e.g. 100 Wei" + , onInput Msgs.PrimaryBrehonDisputeFeeChanged , value "100" ] [] @@ -89,6 +93,7 @@ contractCreatorView model = , input [ class "input ethereum-address primary-brehon-addr" , placeholder "0x00000" + , onInput Msgs.SecondaryBrehonAddrChanged , value "0xe11ba2b4d45eaed5996cd0823791e0c93114882d" ] [] @@ -96,6 +101,7 @@ contractCreatorView model = , input [ class "input ethereum-address primary-brehon-addr" , placeholder "e.g. 100 Wei" + , onInput Msgs.SecondaryBrehonFixedFeeChanged , value "10" ] [] @@ -103,6 +109,7 @@ contractCreatorView model = , input [ class "input ethereum-address primary-brehon-addr" , placeholder "e.g. 100 Wei" + , onInput Msgs.SecondaryBrehonDisputeFeeChanged , value "100" ] [] @@ -112,6 +119,7 @@ contractCreatorView model = , input [ class "input ethereum-address primary-brehon-addr" , placeholder "0x00000" + , onInput Msgs.TertiaryBrehonAddrChanged , value "0xd03ea8624c8c5987235048901fb614fdca89b117" ] [] @@ -119,6 +127,7 @@ contractCreatorView model = , input [ class "input ethereum-address primary-brehon-addr" , placeholder "e.g. 100 Wei" + , onInput Msgs.TertiaryBrehonFixedFeeChanged , value "10" ] [] @@ -126,6 +135,7 @@ contractCreatorView model = , input [ class "input ethereum-address primary-brehon-addr" , placeholder "e.g. 100 Wei" + , onInput Msgs.TertiaryBrehonDisputeFeeChanged , value "100" ] [] diff --git a/app/elm/create/Update.elm b/app/elm/create/Update.elm index 3c75a26..c46b9d1 100644 --- a/app/elm/create/Update.elm +++ b/app/elm/create/Update.elm @@ -16,5 +16,35 @@ updateCreateContract msg model = TxAmountChanged amount -> ( { model | transactionAmount = amount }, Cmd.none ) + TermsChanged termsAndConditions -> + ( { model | termsAndConditions = termsAndConditions }, Cmd.none ) + + PrimaryBrehonAddrChanged addr -> + ( { model | primaryBrehonAddr = Just addr }, Cmd.none ) + + PrimaryBrehonFixedFeeChanged fixedFee -> + ( { model | primaryBrehonFixedFee = fixedFee }, Cmd.none ) + + PrimaryBrehonDisputeFeeChanged disputeFee -> + ( { model | primaryBrehonDisputeFee = disputeFee }, Cmd.none ) + + SecondaryBrehonAddrChanged addr -> + ( { model | secondaryBrehonAddr = Just addr }, Cmd.none ) + + SecondaryBrehonFixedFeeChanged fixedFee -> + ( { model | secondaryBrehonFixedFee = fixedFee }, Cmd.none ) + + SecondaryBrehonDisputeFeeChanged disputeFee -> + ( { model | secondaryBrehonDisputeFee = disputeFee }, Cmd.none ) + + TertiaryBrehonAddrChanged addr -> + ( { model | tertiaryBrehonAddr = Just addr }, Cmd.none ) + + TertiaryBrehonFixedFeeChanged fixedFee -> + ( { model | tertiaryBrehonFixedFee = fixedFee }, Cmd.none ) + + TertiaryBrehonDisputeFeeChanged disputeFee -> + ( { model | tertiaryBrehonDisputeFee = disputeFee }, Cmd.none ) + _ -> ( model, Cmd.none ) From 2e081cd7a947bbba58d65db2c7c8e3a2e87c2444 Mon Sep 17 00:00:00 2001 From: Prashant Singh Pawar Date: Sun, 4 Jun 2017 10:43:41 -0400 Subject: [PATCH 10/13] - Using Brehon struct instead of individual attribute in ContractCreatorModel - Made create as the home page --- app/elm/Models.elm | 24 ++++++------------------ app/elm/UrlParsing.elm | 2 +- app/elm/create/Update.elm | 35 +++++++++++++++++++++++++---------- 3 files changed, 32 insertions(+), 29 deletions(-) diff --git a/app/elm/Models.elm b/app/elm/Models.elm index df8383c..4d6cb9d 100644 --- a/app/elm/Models.elm +++ b/app/elm/Models.elm @@ -40,15 +40,9 @@ initContractCreatorModel = (Just "0xffcf8fdee72ac11b5c542428b35eef5769c409f0") "500" "Party A agrees to sell Party B a 1996 Rolex watch for 500 Wei." - (Just "0x22d491bde2303f2f43325b2108d26f1eaba1e32b") - "10" - "100" - (Just "0xe11ba2b4d45eaed5996cd0823791e0c93114882d") - "10" - "100" - (Just "0xd03ea8624c8c5987235048901fb614fdca89b117") - "10" - "100" + (Brehon (Just "0x22d491bde2303f2f43325b2108d26f1eaba1e32b") False "10" "100") + (Brehon (Just "0xe11ba2b4d45eaed5996cd0823791e0c93114882d") False "10" "100") + (Brehon (Just "0xd03ea8624c8c5987235048901fb614fdca89b117") False "10" "100") type alias Model = @@ -64,15 +58,9 @@ type alias ContractCreatorModel = , partyB : Address , transactionAmount : Wei , termsAndConditions : String - , primaryBrehonAddr : Address - , primaryBrehonFixedFee : Wei - , primaryBrehonDisputeFee : Wei - , secondaryBrehonAddr : Address - , secondaryBrehonFixedFee : Wei - , secondaryBrehonDisputeFee : Wei - , tertiaryBrehonAddr : Address - , tertiaryBrehonFixedFee : Wei - , tertiaryBrehonDisputeFee : Wei + , primaryBrehon : Brehon + , secondaryBrehon : Brehon + , tertiaryBrehon : Brehon } diff --git a/app/elm/UrlParsing.elm b/app/elm/UrlParsing.elm index dd8ae6e..19f10cb 100644 --- a/app/elm/UrlParsing.elm +++ b/app/elm/UrlParsing.elm @@ -11,6 +11,6 @@ type Route route : Url.Parser (Route -> a) a route = Url.oneOf - [ Url.map Create (s "create") + [ Url.map Create top , Url.map Contract (s "contract" string) ] diff --git a/app/elm/create/Update.elm b/app/elm/create/Update.elm index c46b9d1..81fc8f8 100644 --- a/app/elm/create/Update.elm +++ b/app/elm/create/Update.elm @@ -1,7 +1,7 @@ module Create.Update exposing (..) import Msgs exposing (..) -import Models exposing (ContractCreatorModel) +import Models exposing (ContractCreatorModel, Wei, Address, Brehon) updateCreateContract : Msg -> ContractCreatorModel -> ( ContractCreatorModel, Cmd Msg ) @@ -20,31 +20,46 @@ updateCreateContract msg model = ( { model | termsAndConditions = termsAndConditions }, Cmd.none ) PrimaryBrehonAddrChanged addr -> - ( { model | primaryBrehonAddr = Just addr }, Cmd.none ) + ( { model | primaryBrehon = updateBrehonAddr model.primaryBrehon (Just addr) }, Cmd.none ) PrimaryBrehonFixedFeeChanged fixedFee -> - ( { model | primaryBrehonFixedFee = fixedFee }, Cmd.none ) + ( { model | primaryBrehon = updateBrehonFixedFee model.primaryBrehon fixedFee }, Cmd.none ) PrimaryBrehonDisputeFeeChanged disputeFee -> - ( { model | primaryBrehonDisputeFee = disputeFee }, Cmd.none ) + ( { model | primaryBrehon = updateBrehonDisputeFee model.primaryBrehon disputeFee }, Cmd.none ) SecondaryBrehonAddrChanged addr -> - ( { model | secondaryBrehonAddr = Just addr }, Cmd.none ) + ( { model | secondaryBrehon = updateBrehonAddr model.secondaryBrehon (Just addr) }, Cmd.none ) SecondaryBrehonFixedFeeChanged fixedFee -> - ( { model | secondaryBrehonFixedFee = fixedFee }, Cmd.none ) + ( { model | secondaryBrehon = updateBrehonFixedFee model.secondaryBrehon fixedFee }, Cmd.none ) SecondaryBrehonDisputeFeeChanged disputeFee -> - ( { model | secondaryBrehonDisputeFee = disputeFee }, Cmd.none ) + ( { model | secondaryBrehon = updateBrehonDisputeFee model.secondaryBrehon disputeFee }, Cmd.none ) TertiaryBrehonAddrChanged addr -> - ( { model | tertiaryBrehonAddr = Just addr }, Cmd.none ) + ( { model | tertiaryBrehon = updateBrehonAddr model.tertiaryBrehon (Just addr) }, Cmd.none ) TertiaryBrehonFixedFeeChanged fixedFee -> - ( { model | tertiaryBrehonFixedFee = fixedFee }, Cmd.none ) + ( { model | tertiaryBrehon = updateBrehonFixedFee model.tertiaryBrehon fixedFee }, Cmd.none ) TertiaryBrehonDisputeFeeChanged disputeFee -> - ( { model | tertiaryBrehonDisputeFee = disputeFee }, Cmd.none ) + ( { model | tertiaryBrehon = updateBrehonDisputeFee model.tertiaryBrehon disputeFee }, Cmd.none ) _ -> ( model, Cmd.none ) + + +updateBrehonAddr : Brehon -> Address -> Brehon +updateBrehonAddr brehon addr = + { brehon | addr = addr } + + +updateBrehonFixedFee : Brehon -> Wei -> Brehon +updateBrehonFixedFee brehon fixedFee = + { brehon | fixedFee = fixedFee } + + +updateBrehonDisputeFee : Brehon -> Wei -> Brehon +updateBrehonDisputeFee brehon disputeFee = + { brehon | disputeFee = disputeFee } From 711274341fa424ea60e6c13a3cffa291674982d7 Mon Sep 17 00:00:00 2001 From: Prashant Singh Pawar Date: Sun, 4 Jun 2017 13:00:25 -0400 Subject: [PATCH 11/13] - Added requestCreateContract event - Now pressing the button 'Create Contract' does the job from Elm's perspective and ball is in JS code --- app/elm/Commands.elm | 12 +++++++++++- app/elm/Msgs.elm | 2 ++ app/elm/Update.elm | 3 +++ app/elm/View.elm | 4 +++- app/elm/Web3/BrehonAPI.elm | 4 ++++ app/elm/create/Update.elm | 4 ++++ app/javascripts/index.js | 3 +++ 7 files changed, 30 insertions(+), 2 deletions(-) diff --git a/app/elm/Commands.elm b/app/elm/Commands.elm index 2230709..4979564 100644 --- a/app/elm/Commands.elm +++ b/app/elm/Commands.elm @@ -1,6 +1,6 @@ module Commands exposing (..) -import Models exposing (Address, Wei, PartyModel, BrehonModel) +import Models exposing (Address, Wei, PartyModel, BrehonModel, ContractCreatorModel) import Task exposing (perform) import Time as Time exposing (Time, now) import Msgs exposing (Msg) @@ -86,6 +86,7 @@ raiseAppeal : Address -> Cmd Msg raiseAppeal addr = requestRaiseAppeal addr + raiseSecondAppeal : Address -> Cmd Msg raiseSecondAppeal addr = requestRaiseSecondAppeal addr @@ -97,6 +98,15 @@ adjudicate addr awardPartyA awardPartyB = +{- Contract creator commands -} + + +createContract : ContractCreatorModel -> Cmd Msg +createContract model = + requestCreateContract model + + + {- For Debugging purposes -} diff --git a/app/elm/Msgs.elm b/app/elm/Msgs.elm index 9e4c9dd..2631a51 100644 --- a/app/elm/Msgs.elm +++ b/app/elm/Msgs.elm @@ -13,6 +13,7 @@ import Models , Parties , Brehons , Event + , ContractCreatorModel ) import Navigation @@ -63,4 +64,5 @@ type Msg | TertiaryBrehonAddrChanged String | TertiaryBrehonFixedFeeChanged Wei | TertiaryBrehonDisputeFeeChanged Wei + | CreateContract ContractCreatorModel | None diff --git a/app/elm/Update.elm b/app/elm/Update.elm index 438ad76..41accf8 100644 --- a/app/elm/Update.elm +++ b/app/elm/Update.elm @@ -164,5 +164,8 @@ update msg model = TertiaryBrehonDisputeFeeChanged disputeFee -> ( { model | creatorModel = first updateCreateContractMsg }, second updateCreateContractMsg ) + CreateContract creatorModel -> + ( { model | creatorModel = first updateCreateContractMsg }, second updateCreateContractMsg ) + None -> ( model, Cmd.none ) diff --git a/app/elm/View.elm b/app/elm/View.elm index fe065ff..15de6c0 100644 --- a/app/elm/View.elm +++ b/app/elm/View.elm @@ -142,7 +142,9 @@ contractCreatorView model = ] , a [ class "btn btn-primary" - , href ("#contract/" ++ toJustString identity model.partyA) + , onClick (Msgs.CreateContract model) + + --, href ("#contract/" ++ toJustString identity model.partyA) ] [ text "Create" ] diff --git a/app/elm/Web3/BrehonAPI.elm b/app/elm/Web3/BrehonAPI.elm index abb40c3..b2f94a2 100644 --- a/app/elm/Web3/BrehonAPI.elm +++ b/app/elm/Web3/BrehonAPI.elm @@ -13,6 +13,7 @@ import Models , BrehonModel , Brehons , Wei + , ContractCreatorModel ) @@ -110,3 +111,6 @@ port receiveAwards : (Maybe Awards -> msg) -> Sub msg port requestWithdrawFunds : Address -> Cmd msg + + +port requestCreateContract : ContractCreatorModel -> Cmd msg diff --git a/app/elm/create/Update.elm b/app/elm/create/Update.elm index 81fc8f8..5c41775 100644 --- a/app/elm/create/Update.elm +++ b/app/elm/create/Update.elm @@ -2,6 +2,7 @@ module Create.Update exposing (..) import Msgs exposing (..) import Models exposing (ContractCreatorModel, Wei, Address, Brehon) +import Commands exposing (..) updateCreateContract : Msg -> ContractCreatorModel -> ( ContractCreatorModel, Cmd Msg ) @@ -46,6 +47,9 @@ updateCreateContract msg model = TertiaryBrehonDisputeFeeChanged disputeFee -> ( { model | tertiaryBrehon = updateBrehonDisputeFee model.tertiaryBrehon disputeFee }, Cmd.none ) + CreateContract creatorModel -> + ( model, createContract creatorModel ) + _ -> ( model, Cmd.none ) diff --git a/app/javascripts/index.js b/app/javascripts/index.js index a86fd84..ba443ec 100644 --- a/app/javascripts/index.js +++ b/app/javascripts/index.js @@ -271,6 +271,9 @@ function portHooks(elmApp, currentProvider) { ports.requestWithdrawFunds.subscribe(withdrawingAddress => brehonApp.withdrawFunds(withdrawingAddress) .then(() => updateContractInfo(ports, brehonApp))); + + ports.requestCreateContract.subscribe(partyAAddr => + console.info(partyAAddr)); } window.addEventListener('load', () => { From 462f4b7cab47b5df489d6614fb44af01fa54df1c Mon Sep 17 00:00:00 2001 From: Prashant Singh Pawar Date: Sun, 4 Jun 2017 14:50:21 -0400 Subject: [PATCH 12/13] - Changed PartyAddr from string to Party struct --- app/elm/Models.elm | 8 ++++---- app/elm/create/Update.elm | 11 ++++++++--- 2 files changed, 12 insertions(+), 7 deletions(-) diff --git a/app/elm/Models.elm b/app/elm/Models.elm index 4d6cb9d..b880f15 100644 --- a/app/elm/Models.elm +++ b/app/elm/Models.elm @@ -36,8 +36,8 @@ initContractInfo = initContractCreatorModel : ContractCreatorModel initContractCreatorModel = ContractCreatorModel - (Just "0x90f8bf6a479f320ead074411a4b0e7944ea8c9c1") - (Just "0xffcf8fdee72ac11b5c542428b35eef5769c409f0") + (Party (Just "0x90f8bf6a479f320ead074411a4b0e7944ea8c9c1") "0" False) + (Party (Just "0xffcf8fdee72ac11b5c542428b35eef5769c409f0") "0" False) "500" "Party A agrees to sell Party B a 1996 Rolex watch for 500 Wei." (Brehon (Just "0x22d491bde2303f2f43325b2108d26f1eaba1e32b") False "10" "100") @@ -54,8 +54,8 @@ type alias Model = type alias ContractCreatorModel = - { partyA : Address - , partyB : Address + { partyA : Party + , partyB : Party , transactionAmount : Wei , termsAndConditions : String , primaryBrehon : Brehon diff --git a/app/elm/create/Update.elm b/app/elm/create/Update.elm index 5c41775..fa23ff3 100644 --- a/app/elm/create/Update.elm +++ b/app/elm/create/Update.elm @@ -1,7 +1,7 @@ module Create.Update exposing (..) import Msgs exposing (..) -import Models exposing (ContractCreatorModel, Wei, Address, Brehon) +import Models exposing (ContractCreatorModel, Wei, Address, Brehon, Party) import Commands exposing (..) @@ -9,10 +9,10 @@ updateCreateContract : Msg -> ContractCreatorModel -> ( ContractCreatorModel, Cm updateCreateContract msg model = case msg of PartyAAddrChanged addr -> - ( { model | partyA = Just addr }, Cmd.none ) + ( { model | partyA = updatePartyAddr model.partyA (Just addr) }, Cmd.none ) PartyBAddrChanged addr -> - ( { model | partyB = Just addr }, Cmd.none ) + ( { model | partyB = updatePartyAddr model.partyB (Just addr) }, Cmd.none ) TxAmountChanged amount -> ( { model | transactionAmount = amount }, Cmd.none ) @@ -54,6 +54,11 @@ updateCreateContract msg model = ( model, Cmd.none ) +updatePartyAddr : Party -> Address -> Party +updatePartyAddr party addr = + { party | addr = addr } + + updateBrehonAddr : Brehon -> Address -> Brehon updateBrehonAddr brehon addr = { brehon | addr = addr } From 8d056307f9bec01b3a0d5498c820b0d173b90f09 Mon Sep 17 00:00:00 2001 From: Prashant Singh Pawar Date: Sat, 17 Jun 2017 22:37:41 -0400 Subject: [PATCH 13/13] - Some renaming --- .../{BrehonContractFactory.sol => BrehonContractCreator.sol} | 0 ...{3_deploy_factory_contract.js => 3_deploy_creator_contract.js} | 0 ...structor.spec.js => BrehonContractCreator_Constructor.spec.js} | 0 ...ct.spec.js => BrehonContractCreator_newBrehonContract.spec.js} | 0 4 files changed, 0 insertions(+), 0 deletions(-) rename contracts/{BrehonContractFactory.sol => BrehonContractCreator.sol} (100%) rename migrations/{3_deploy_factory_contract.js => 3_deploy_creator_contract.js} (100%) rename test/{BrehonContractFactory_Constructor.spec.js => BrehonContractCreator_Constructor.spec.js} (100%) rename test/{BrehonContractFactory_newBrehonContract.spec.js => BrehonContractCreator_newBrehonContract.spec.js} (100%) diff --git a/contracts/BrehonContractFactory.sol b/contracts/BrehonContractCreator.sol similarity index 100% rename from contracts/BrehonContractFactory.sol rename to contracts/BrehonContractCreator.sol diff --git a/migrations/3_deploy_factory_contract.js b/migrations/3_deploy_creator_contract.js similarity index 100% rename from migrations/3_deploy_factory_contract.js rename to migrations/3_deploy_creator_contract.js diff --git a/test/BrehonContractFactory_Constructor.spec.js b/test/BrehonContractCreator_Constructor.spec.js similarity index 100% rename from test/BrehonContractFactory_Constructor.spec.js rename to test/BrehonContractCreator_Constructor.spec.js diff --git a/test/BrehonContractFactory_newBrehonContract.spec.js b/test/BrehonContractCreator_newBrehonContract.spec.js similarity index 100% rename from test/BrehonContractFactory_newBrehonContract.spec.js rename to test/BrehonContractCreator_newBrehonContract.spec.js