lamassu/lamassu-server
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

chore: cleanup, node14 and new admin default

Browse source
This commit is contained in:
Taranto 2020-10-16 17:26:30 +01:00 • committed by Josh Harvey
parent c7c18633d7
commit 89bb9a8f25
244 changed files with 3957 additions and 39487 deletions
Download patch file Download diff file Expand all files Collapse all files

0
.dummy
View file

1
.migrate-stress
View file

@ -1 +0,0 @@
{"migrations":[{"title":"001-initial.js"},{"title":"002-bills.js"},{"title":"003-device-events.js"},{"title":"004-transactions-reload.js"},{"title":"005-addCrypto.js"},{"title":"006-add-machine-config.js"},{"title":"007-add-phone.js"},{"title":"008-add-two-way.js"},{"title":"009-update-timestamps.js"},{"title":"010-cached-requests.js"},{"title":"011-transactions-reload-2.js"},{"title":"012-add-hd-path-serial.js"},{"title":"013-add-last-checked.js"},{"title":"014-session-to-tx-id.js"},{"title":"015-paired_devices.js"},{"title":"016-new_cached_requests_table.js"},{"title":"017-user_tokens.js"},{"title":"018-alter_devices.js"},{"title":"019-remove-dispense-counts.js"},{"title":"020-add-server-events.js"},{"title":"021-config-version-id.js"},{"title":"022-add_cash_in_sent.js"},{"title":"023-add-dispenses-to-cash-out.js"},{"title":"024-consolidate-hd.js"},{"title":"025-create_trades.js"},{"title":"026-add_send_confirmed.js"},{"title":"027-tx_errors.js"},{"title":"028-cash_out_actions.js"},{"title":"029-add_valid_to_user_config.js"},{"title":"030-cash-out-provision.js"},{"title":"031-remove_name_from_devices.js"},{"title":"032-create_machine_pings_table.js"},{"title":"033-add_cash_in_fee.js"},{"title":"034-add_cash_out_error_code.js"},{"title":"035-log_bank_notes.js"}],"path":"/Users/josh/projects/lamassu-server/.migrate-stress","pos":35}

3
INSTALL-NIX.md
View file

@ -42,11 +42,10 @@ Notes:
## Set up database ## Set up database
Important: lamassu-migrate currently gripes about a QueryResultError. Ignore this, it works anyway. Also, ignore Debug lines from lamassu-apply-defaults. Important: lamassu-migrate currently gripes about a QueryResultError. Ignore this, it works anyway.
``` ```
node bin/lamassu-migrate node bin/lamassu-migrate
node bin/lamassu-apply-defaults
``` ```
## Register admin user ## Register admin user

3
INSTALL.md
View file

@ -60,11 +60,10 @@ Notes:
## Set up database ## Set up database
Important: lamassu-migrate currently gripes about a QueryResultError. Ignore this, it works anyway. Also, ignore Debug lines from lamassu-apply-defaults. Important: lamassu-migrate currently gripes about a QueryResultError. Ignore this, it works anyway.
``` ```
node bin/lamassu-migrate node bin/lamassu-migrate
node bin/lamassu-apply-defaults
``` ```
## Register admin user ## Register admin user

1
Procfile
View file

@ -1 +0,0 @@
web: node lib/app.js

36
TODO.json
View file

@ -1,36 +0,0 @@
{
"groups": [
{
"code": "balanceAlerts",
"fields": [
"cashInAlertThreshold"
]
},
{
"code": "compliance",
"fields": [
"smsVerificationActive",
"smsVerificationThreshold",
"idCardDataVerificationActive",
"idCardDataVerificationThreshold",
"idCardPhotoVerificationActive",
"idCardPhotoVerificationThreshold",
"sanctionsVerificationActive",
"sanctionsVerificationThreshold",
"frontCameraVerificationActive",
"frontCameraVerificationThreshold",
"hardLimitVerificationActive",
"hardLimitVerificationThreshold",
"receiptPrintingActive",
"rejectAddressReuseActive"
]
},
{
"code": "notifications",
"fields": [
"sms",
"email"
]
}
]
}

180
Vagrantfile vendored
View file

@ -1,180 +0,0 @@
# -*- mode: ruby -*-
# vi: set ft=ruby :
# All Vagrant configuration is done below. The "2" in Vagrant.configure
# configures the configuration version (we support older styles for
# backwards compatibility). Please don't change it unless you know what
# you're doing.
Vagrant.configure(2) do |config|
# The most common configuration options are documented and commented below.
# For a complete reference, please see the online documentation at
# vagrantup.com
# Every Vagrant virtual environment requires a box to build off of.
config.vm.box = "ubuntu/xenial64"
# Disable automatic box update checking. If you disable this, then
# boxes will only be checked for updates when the user runs
# `vagrant box outdated`. This is not recommended.
# config.vm.box_check_update = false
# Create a forwarded port mapping which allows access to a specific port
# within the machine from a port on the host machine. In the example below,
# accessing "localhost:8080" will access port 80 on the guest machine.
# config.vm.network "forwarded_port", guest: 80, host: 8080
# Create a private network, which allows host-only access to the machine
# using a specific IP.
# config.vm.network "private_network", ip: "192.168.33.10"
# Create a public network, which generally matched to bridged network.
# Bridged networks make the machine appear as another physical device on
# your network.
# config.vm.network "public_network"
# If true, then any SSH connections made will enable agent forwarding.
# Default value: false
# config.ssh.forward_agent = true
# Share an additional folder to the guest VM. The first argument is
# the path on the host to the actual folder. The second argument is
# the path on the guest to mount the folder. And the optional third
# argument is a set of non-required options.
# config.vm.synced_folder "../data", "/vagrant_data"
# Provider-specific configuration so you can fine-tune various
# backing providers for Vagrant. These expose provider-specific options.
# Example for VirtualBox:
#
config.vm.provider "virtualbox" do |vb|
# # Don't boot with headless mode
# vb.gui = true
#
# # Use VBoxManage to customize the VM. For example to change memory:
vb.customize ["modifyvm", :id, "--memory", "4096"]
end
#
# View the documentation for the provider you're using for more
# information on available options.
# Enable provisioning with CFEngine. CFEngine Community packages are
# automatically installed. For example, configure the host as a
# policy server and optionally a policy file to run:
#
# config.vm.provision "cfengine" do |cf|
# cf.am_policy_hub = true
# # cf.run_file = "motd.cf"
# end
#
# You can also configure and bootstrap a client to an existing
# policy server:
#
# config.vm.provision "cfengine" do |cf|
# cf.policy_server_address = "10.0.2.15"
# end
# Enable provisioning with Puppet stand alone. Puppet manifests
# are contained in a directory path relative to this Vagrantfile.
# You will need to create the manifests directory and a manifest in
# the file default.pp in the manifests_path directory.
#
# config.vm.provision "puppet" do |puppet|
# puppet.manifests_path = "manifests"
# puppet.manifest_file = "default.pp"
# end
# Enable provisioning with Chef Solo, specifying a cookbooks path, roles
# path, and data_bags path (all relative to this Vagrantfile), and adding
# some recipes and/or roles.
#
# config.vm.provision "chef_solo" do |chef|
# chef.cookbooks_path = "~/chef/cookbooks"
# chef.roles_path = "~/chef/roles"
# chef.data_bags_path = "~/chef/data_bags"
#
# chef.add_recipe "mysql"
# chef.add_role "web"
#
# chef.json = { mysql_password: "foo" }
# end
#
# Chef Solo will automatically install the latest version of Chef for you.
# This can be configured in the provisioner block:
#
# config.vm.provision "chef_solo" do |chef|
# chef.version = "11.16.4"
# end
#
# Alternative you can disable the installation of Chef entirely:
#
# config.vm.provision "chef_solo" do |chef|
# chef.install = false
# end
# Enable provisioning with Chef Zero. The Chef Zero provisioner accepts the
# exact same parameter as the Chef Solo provisioner:
#
# config.vm.provision "chef_zero" do |chef|
# chef.cookbooks_path = "~/chef/cookbooks"
# chef.roles_path = "~/chef/roles"
# chef.data_bags_path = "~/chef/data_bags"
#
# chef.add_recipe "mysql"
# chef.add_role "web"
#
# # You may also specify custom JSON attributes:
# chef.json = { mysql_password: "foo" }
# end
# Enable provisioning with Chef Server, specifying the chef server URL,
# and the path to the validation key (relative to this Vagrantfile).
#
# The Hosted Chef platform uses HTTPS. Substitute your organization for
# ORGNAME in the URL and validation key.
#
# If you have your own Chef Server, use the appropriate URL, which may be
# HTTP instead of HTTPS depending on your configuration. Also change the
# validation key to validation.pem.
#
# config.vm.provision "chef_client" do |chef|
# chef.chef_server_url = "https://api.opscode.com/organizations/ORGNAME"
# chef.validation_key_path = "ORGNAME-validator.pem"
# end
#
# If you're using the Hosted Chef platform, your validator client is
# ORGNAME-validator, replacing ORGNAME with your organization name.
#
# If you have your own Chef Server, the default validation client name is
# chef-validator, unless you changed the configuration.
#
# chef.validation_client_name = "ORGNAME-validator"
#
# Chef Client will automatically install the latest version of Chef for you.
# This can be configured in the provisioner block:
#
# config.vm.provision "chef_client" do |chef|
# chef.version = "11.16.4"
# end
#
# Alternative you can disable the installation of Chef entirely:
#
# config.vm.provision "chef_client" do |chef|
# chef.install = false
# end
# Enable provisioning with Chef Apply, specifying an inline recipe to execute
# on the target system.
#
# config.vm.provision "chef_apply" do |chef|
# chef.recipe = <<-RECIPE
# package "curl"
# RECIPE
# end
#
# Chef Apply will automatically install the latest version of Chef for you.
# This can be configured in the provisioner block:
#
# config.vm.provision "chef_apply" do |chef|
# chef.version = "11.16.4"
# end
end

2
bin/lamassu-admin-server
View file

@ -1,5 +1,5 @@
#!/usr/bin/env node #!/usr/bin/env node
const adminServer = require('../lib/admin/admin-server') const adminServer = require('../lib/new-admin/admin-server')
adminServer.run() adminServer.run()

13
bin/lamassu-apply-defaults
View file

@ -1,13 +0,0 @@
#!/usr/bin/env node
const applyDefaults = require('../lib/apply-defaults')
applyDefaults.run()
.then(() => {
console.log('Success.')
process.exit(0)
})
.catch(err => {
console.error(err)
process.exit(1)
})

1
bin/lamassu-nuke-db
View file

@ -17,7 +17,6 @@ EOF
rm -f "/etc/lamassu/.migrate" rm -f "/etc/lamassu/.migrate"
lamassu-migrate lamassu-migrate
lamassu-apply-defaults
echo "Done." echo "Done."
;; ;;
* ) * )

10
bin/lamassu-register
View file

@ -16,17 +16,15 @@ if (!name) {
process.exit(2) process.exit(2)
} }
login.generateOTP(name) login.generateOTP(name).then(otp => {
.then(otp => {
if (domain === 'localhost') { if (domain === 'localhost') {
console.log(`https://${domain}:8070?otp=${otp}`) console.log(`https://${domain}:3000/register?otp=${otp}`)
} else { } else {
console.log(`https://${domain}?otp=${otp}`) console.log(`https://${domain}/register?otp=${otp}`)
} }
process.exit(0) process.exit(0)
}) }).catch(err => {
.catch(err => {
console.log('Error: %s', err) console.log('Error: %s', err)
process.exit(3) process.exit(3)
}) })

5
bin/new-lamassu-admin-server
View file

@ -1,5 +0,0 @@
#!/usr/bin/env node
const adminServer = require('../lib/new-admin/admin-server')
adminServer.run()

5
bin/old-lamassu-admin-server Executable file
View file

@ -0,0 +1,5 @@
#!/usr/bin/env node
const adminServer = require('../lib/admin/admin-server')
adminServer.run()

10
bin/new-lamassu-register → bin/old-lamassu-register
View file

@ -16,15 +16,17 @@ if (!name) {
process.exit(2) process.exit(2)
} }
login.generateOTP(name).then(otp => { login.generateOTP(name)
.then(otp => {
if (domain === 'localhost') { if (domain === 'localhost') {
console.log(`https://${domain}:3000/register?otp=${otp}`) console.log(`https://${domain}:8070?otp=${otp}`)
} else { } else {
console.log(`https://${domain}/register?otp=${otp}`) console.log(`https://${domain}?otp=${otp}`)
} }
process.exit(0) process.exit(0)
}).catch(err => { })
.catch(err => {
console.log('Error: %s', err) console.log('Error: %s', err)
process.exit(3) process.exit(3)
}) })

30
bin/validate-config.js
View file

@ -1,30 +0,0 @@
'use strict'
const db = require('../lib/db')
const configValidate = require('../lib/config-validate')
function pp (o) {
console.log(require('util').inspect(o, {depth: null, colors: true}))
}
function dbFetchConfig () {
return db.oneOrNone(
'select data from user_config where type=$1 order by created desc limit 1',
['config']
)
.then(row => row && row.data)
}
dbFetchConfig()
.then(config => {
pp(config)
return configValidate.validate(config.config)
})
.then(() => {
console.log('success.')
process.exit(0)
})
.catch(e => {
console.log(e)
process.exit(1)
})

4
cartridges.json
View file

@ -1,4 +0,0 @@
{
"cartridges": [1, 20],
"virtualCartridges": [5]
}

35
certs.sh
View file

@ -1,35 +0,0 @@
DOMAIN=localhost
mkdir -p certs
openssl genrsa \
-out certs/root-ca.key.pem \
4096
openssl req \
-x509 \
-new \
-nodes \
-key certs/root-ca.key.pem \
-days 3560 \
-out certs/root-ca.crt.pem \
-subj "/C=IS/ST=/L=Reykjavik/O=Lamassu Operator CA/CN=lamassu-operator.is"
openssl genrsa \
-out certs/server.key.pem \
4096
# Create a request from your Device, which your Root CA will sign
openssl req -new \
-key certs/server.key.pem \
-out certs/server.csr.pem \
-subj "/C=IS/ST=/L=Reykjavik/O=Lamassu Operator/CN=$DOMAIN"
# Sign the request from Device with your Root CA
openssl x509 \
-req -in certs/server.csr.pem \
-CA certs/root-ca.crt.pem \
-CAkey certs/root-ca.key.pem \
-CAcreateserial \
-out certs/server.crt.pem \
-days 3650

1
connect.txt
View file

@ -1 +0,0 @@
http://192.168.1.108:8070?otp=faa31556ce0d7c3f11315a7d58a3b009274087de4078bc55f07b58d784cc25a5

15
crypto-schema.json
View file

@ -1,15 +0,0 @@
{
"jsonSchema": {
"title": "Crypto Settings",
"type": "object",
"required": [],
"properties": {
"commission": {"type": "number", "title": "Cash-in Commission", "minimum": 0, "description": 3.5},
"cashOutCommission": {"type": "number", "title": "Cash-out Commission", "minimum": 0},
"fiatTxLimit": {"type": "number", "title": "Cash-out Limit", "minimum": 0}
}
},
"uiSchema": {
"ui:order": ["commission", "cashOutCommission", "fiatTxLimit"]
}
}

1
data-notes.txt
View file

@ -1 +0,0 @@
Countries: https://github.com/mledoze/countries

0
countries.json → data/countries.json
View file

0
currencies.json → data/currencies.json
View file

0
languages.json → data/languages.json
View file

8
lamassu-admin-elm/.gitignore vendored
View file

@ -1,8 +0,0 @@
node_modules
elm-stuff
build/styles.css
build/elm.js
.vscode
.idea

28
lamassu-admin-elm/README.md
View file

@ -1,28 +0,0 @@
# lamassu-admin
## Development
Start the hot-reloading webpack dev server:
npm start
Navigate to <http://localhost:8080>.
Any changes you make to your files (.elm, .js, .css, etc.) will trigger
a hot reload.
## Production
When you're ready to deploy:
npm run build
This will create a `dist` folder:
.
├── dist
│   ├── index.html
│   ├── 5df766af1ced8ff1fe0a.css
│   └── 5df766af1ced8ff1fe0a.js

24
lamassu-admin-elm/UNLICENSE
View file

@ -1,24 +0,0 @@
This is free and unencumbered software released into the public domain.
Anyone is free to copy, modify, publish, use, compile, sell, or
distribute this software, either in source code form or as a compiled
binary, for any purpose, commercial or non-commercial, and by any
means.
In jurisdictions that recognize copyright laws, the author or authors
of this software dedicate any and all copyright interest in the
software to the public domain. We make this dedication for the benefit
of the public at large and to the detriment of our heirs and
successors. We intend this dedication to be an overt act of
relinquishment in perpetuity of all present and future rights to this
software under copyright law.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR
OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
OTHER DEALINGS IN THE SOFTWARE.
For more information, please refer to <http://unlicense.org>

23
lamassu-admin-elm/build/index.html
View file

@ -1,23 +0,0 @@
<html>
<head>
<base href="/">
</head>
<body>
<script src="bower_components/webcomponentsjs/webcomponents.min.js"></script>
<script src="bower_components/qrjs/qr.js"></script>
<script src="bower_components/qr-code/src/qr-code.js"></script>
<script src="elm.js"></script>
<script>
Elm.Main.fullscreen()
</script>
<link rel="stylesheet" href="bower_components/gridism/gridism.css">
<link rel="stylesheet" href="styles.css">
<style>
@keyframes fadein {
from { opacity: 0; }
to { opacity: 1; }
}
</style>
<meta name="viewport" content="width=device-width,initial-scale=1">
</body>
</html>

3
lamassu-admin-elm/cli.txt
View file

@ -1,3 +0,0 @@
ls src/Css/* | entr elm-css src/Stylesheets.elm
find src | entr elm-make src/Main.elm --output ../public/elm.js
find src | entr elm-make src/Lamassu.elm --output ../public/lamassu-elm.js

37
lamassu-admin-elm/elm-package.json
View file

@ -1,37 +0,0 @@
{
"version": "1.0.0",
"summary": "helpful summary of your project, less than 80 characters",
"repository": "https://github.com/user/project.git",
"license": "Unlicense",
"source-directories": [
"src"
],
"exposed-modules": [],
"dependencies": {
"NoRedInk/elm-decode-pipeline": "3.0.0 <= v < 4.0.0",
"arturopala/elm-monocle": "1.3.1 <= v < 2.0.0",
"elm-community/json-extra": "2.0.0 <= v < 3.0.0",
"elm-community/maybe-extra": "4.0.0 <= v < 5.0.0",
"elm-lang/core": "5.0.0 <= v < 6.0.0",
"elm-lang/html": "2.0.0 <= v < 3.0.0",
"elm-lang/http": "1.0.0 <= v < 2.0.0",
"elm-lang/keyboard": "1.0.1 <= v < 2.0.0",
"elm-lang/navigation": "2.0.1 <= v < 3.0.0",
"elm-lang/virtual-dom": "2.0.0 <= v < 3.0.0",
"elm-lang/websocket": "1.0.2 <= v < 2.0.0",
"evancz/elm-markdown": "3.0.1 <= v < 4.0.0",
"evancz/url-parser": "2.0.1 <= v < 3.0.0",
"ggb/numeral-elm": "1.2.3 <= v < 2.0.0",
"justinmimbs/elm-date-extra": "2.0.2 <= v < 3.0.0",
"krisajenkins/remotedata": "4.0.0 <= v < 5.0.0",
"lukewestby/elm-http-builder": "5.1.0 <= v < 6.0.0",
"pablohirafuji/elm-qrcode": "1.0.1 <= v < 2.0.0",
"rluiten/stringdistance": "1.0.3 <= v < 2.0.0",
"rtfeldman/elm-css": "10.0.0 <= v < 11.0.0",
"rtfeldman/elm-css-helpers": "2.1.0 <= v < 3.0.0",
"rtfeldman/elm-css-util": "1.0.2 <= v < 2.0.0",
"rtfeldman/elm-validate": "1.1.3 <= v < 2.0.0",
"tripokey/elm-fuzzy": "5.0.3 <= v < 6.0.0"
},
"elm-version": "0.18.0 <= v < 0.19.0"
}

164
lamassu-admin-elm/src/Account.elm
View file

@ -1,164 +0,0 @@
module Account exposing (..)
import Html exposing (..)
import Html.Events exposing (..)
import Html.Keyed
import RemoteData exposing (..)
import Http
import HttpBuilder exposing (..)
import AccountTypes exposing (..)
import AccountDecoder exposing (..)
import AccountEncoder exposing (..)
import FieldSet.Types
import FieldSet.State
import FieldSet.View
import Css.Admin exposing (..)
import Css.Classes
import Process
import Time exposing (second)
import Task
type alias SubModel =
{ status : SavingStatus
, account : Account
}
type alias Model =
RemoteData.WebData SubModel
type SavingStatus
= Saving
| Saved
| Editing
| NotSaving
toModel : SavingStatus -> Account -> SubModel
toModel status account =
{ status = status, account = account }
getForm : String -> Cmd Msg
getForm code =
get ("/api/account/" ++ code)
|> withExpect (Http.expectJson accountDecoder)
|> send (Result.map (toModel NotSaving) >> RemoteData.fromResult)
|> Cmd.map Load
postForm : Account -> Cmd Msg
postForm account =
post "/api/account"
|> withJsonBody (encodeAccount account)
|> withExpect (Http.expectJson accountDecoder)
|> send (Result.map (toModel Saved) >> RemoteData.fromResult)
|> Cmd.map Load
init : Model
init =
RemoteData.NotAsked
load : String -> ( Model, Cmd Msg )
load code =
( RemoteData.Loading, getForm code )
-- UPDATE
type Msg
= Load Model
| Submit
| FieldSetMsg FieldSet.Types.Msg
| HideSaveIndication
saveUpdate : SubModel -> ( SubModel, Cmd Msg )
saveUpdate model =
let
cmd =
if (model.status == Saved) then
Process.sleep (2 * second)
|> Task.perform (\_ -> HideSaveIndication)
else
Cmd.none
in
model ! [ cmd ]
update : Msg -> Model -> ( Model, Cmd Msg )
update msg webModel =
case msg of
Load newModel ->
RemoteData.update saveUpdate newModel
Submit ->
RemoteData.update (\model -> model ! [ postForm model.account ]) webModel
HideSaveIndication ->
RemoteData.update (\model -> { model | status = NotSaving } ! []) webModel
FieldSetMsg fieldSetMsg ->
let
updateFields model =
FieldSet.State.update fieldSetMsg model.account.fields
newAccount account fields =
{ account | fields = fields }
toModel model fieldsUpdate =
{ model
| account =
newAccount model.account
(Tuple.first fieldsUpdate)
}
! [ Cmd.map FieldSetMsg (Tuple.second fieldsUpdate) ]
mapper model =
updateFields model
|> (toModel model)
in
RemoteData.update mapper webModel
view : Model -> Html Msg
view webModel =
case webModel of
NotAsked ->
div [] []
Loading ->
div [] [ text "Loading..." ]
Failure err ->
div [] [ text (toString err) ]
Success model ->
let
fieldSetView =
Html.Keyed.node "div" [] [ ( model.account.code, (Html.map FieldSetMsg (FieldSet.View.view model.account.fields)) ) ]
statusString =
case model.status of
Saved ->
"Saved"
_ ->
""
in
div []
[ div [ class [ Css.Classes.SectionLabel ] ] [ text model.account.display ]
, form [ id model.account.code ]
[ fieldSetView
, div [ class [ Css.Classes.ButtonRow ] ]
[ div [ onClick Submit, class [ Css.Classes.Button ] ] [ text "Submit" ]
, div [] [ text statusString ]
]
]
]

22
lamassu-admin-elm/src/AccountDecoder.elm
View file

@ -1,22 +0,0 @@
module AccountDecoder exposing (..)
import Json.Decode exposing (..)
import FieldSet.Rest exposing (..)
import AccountTypes exposing (..)
accountDecoder : Decoder Account
accountDecoder =
map3 Account
(field "code" string)
(field "display" string)
(field "fields" (list fieldDecoder))
type alias AccountResult =
Result String Account
decodeAccount : String -> AccountResult
decodeAccount string =
decodeString accountDecoder string

15
lamassu-admin-elm/src/AccountEncoder.elm
View file

@ -1,15 +0,0 @@
module AccountEncoder exposing (..)
import Json.Encode exposing (..)
import AccountTypes exposing (..)
import List
import FieldSet.Rest exposing (..)
encodeAccount : Account -> Value
encodeAccount account =
Json.Encode.object
[ ( "code", string account.code )
, ( "display", string account.display )
, ( "fields", list (List.filterMap encodeField account.fields) )
]

10
lamassu-admin-elm/src/AccountTypes.elm
View file

@ -1,10 +0,0 @@
module AccountTypes exposing (..)
import FieldSet.Types exposing (..)
type alias Account =
{ code : String
, display : String
, fields : List Field
}

16
lamassu-admin-elm/src/AccountsDecoder.elm
View file

@ -1,16 +0,0 @@
module AccountsDecoder exposing (..)
import Json.Decode exposing (..)
accountDecoder : Decoder ( String, String )
accountDecoder =
map2 (,)
(field "code" string)
(field "display" string)
accountsDecoder : Decoder (List ( String, String ))
accountsDecoder =
map identity
(field "accounts" (list accountDecoder))

8
lamassu-admin-elm/src/BasicTypes.elm
View file

@ -1,8 +0,0 @@
module BasicTypes exposing (..)
type SavingStatus
= Saving
| Saved
| Editing
| NotSaving

45
lamassu-admin-elm/src/ClientServerWebsocket.elm
View file

@ -1,45 +0,0 @@
module ClientServerWebsocket exposing (..)
-- Elm might not be the best platform for this kind of thing
-- Hard to do a global lookup table
-- Might be easiest to just use HTTP for this for now
-- No need to prematurely optimize and go against the flow
import WebSocket
type Msg
= OK
| Timeout
type alias Client =
Sub Msg
init : String -> Client
init url =
let
sub =
WebSocket.listen url parsePacket
in
sub
request : Client -> String -> String -> Cmd Msg
request client url payload =
let
cmd =
Cmd.map (respond client) (WebSocket.send url payload)
in
cmd
parsePacket : String -> Msg
parsePacket packet =
OK
respond : client -> (a -> Msg)
respond client =
(\_ -> OK)

77
lamassu-admin-elm/src/Common/Customer/Decoder.elm
View file

@ -1,77 +0,0 @@
module Common.Customer.Decoder exposing (..)
import Json.Decode exposing (..)
import Json.Decode.Extra exposing (date, fromResult)
import Json.Decode.Pipeline exposing (decode, required, optional, hardcoded)
import Common.Customer.Types exposing (..)
customersDecoder : Decoder (List Customer)
customersDecoder =
field "customers" (list customerDecoder)
mapAuthorizedTypes : String -> Decoder Authorized
mapAuthorizedTypes s =
case s of
"blocked" ->
succeed Blocked
"verified" ->
succeed Verified
"automatic" ->
succeed Automatic
_ ->
fail ("No such type " ++ s)
authorizedDecoder : Decoder Authorized
authorizedDecoder =
string
|> andThen mapAuthorizedTypes
idCardDataDecoder : Decoder IdCardData
idCardDataDecoder =
decode IdCardData
|> required "uid" string
customerDecoder : Decoder Customer
customerDecoder =
decode Customer
|> required "id" string
|> required "name" (nullable string)
|> required "phone" (nullable string)
|> required "phoneAt" (nullable date)
|> required "smsOverride" authorizedDecoder
|> required "smsOverrideByName" (nullable string)
|> required "smsOverrideAt" (nullable date)
|> required "created" date
|> required "status" (nullable string)
|> required "authorizedOverride" authorizedDecoder
|> required "authorizedOverrideByName" (nullable string)
|> required "authorizedOverrideAt" (nullable date)
|> required "authorizedAt" (nullable date)
|> required "idCardData" (nullable idCardDataDecoder)
|> required "idCardDataOverride" authorizedDecoder
|> required "idCardDataOverrideByName" (nullable string)
|> required "idCardDataOverrideAt" (nullable date)
|> required "idCardDataAt" (nullable date)
|> required "idCardPhotoPath" (nullable string)
|> required "idCardPhotoOverride" authorizedDecoder
|> required "idCardPhotoOverrideByName" (nullable string)
|> required "idCardPhotoOverrideAt" (nullable date)
|> required "idCardPhotoAt" (nullable date)
|> required "sanctions" (nullable bool)
|> required "sanctionsOverride" authorizedDecoder
|> required "sanctionsOverrideByName" (nullable string)
|> required "sanctionsOverrideAt" (nullable date)
|> required "sanctionsAt" (nullable date)
|> required "frontCameraPath" (nullable string)
|> required "frontCameraOverride" authorizedDecoder
|> required "frontCameraOverrideByName" (nullable string)
|> required "frontCameraOverrideAt" (nullable date)
|> required "frontCameraAt" (nullable date)
|> required "dailyVolume" (nullable string)

67
lamassu-admin-elm/src/Common/Customer/Types.elm
View file

@ -1,67 +0,0 @@
module Common.Customer.Types exposing (..)
import Date exposing (Date)
type Authorized
= Automatic
| Blocked
| Verified
type alias Customers =
List Customer
type alias IdCardData =
{ uid : String }
type alias Customer =
{ id : String
, name : Maybe String
, phone : Maybe String
, phoneAt : Maybe Date
, smsOverride : Authorized
, smsOverrideByName : Maybe String
, smsOverrideAt : Maybe Date
, created : Date
, status : Maybe String
, authorizedOverride : Authorized
, authorizedOverrideByName : Maybe String
, authorizedOverrideAt : Maybe Date
, authorizedAt : Maybe Date
, idCardData : Maybe IdCardData
, idCardDataOverride : Authorized
, idCardDataOverrideByName : Maybe String
, idCardDataOverrideAt : Maybe Date
, idCardDataAt : Maybe Date
, idCardPhotoPath : Maybe String
, idCardPhotoOverride : Authorized
, idCardPhotoOverrideByName : Maybe String
, idCardPhotoOverrideAt : Maybe Date
, idCardPhotoAt : Maybe Date
, sanctions : Maybe Bool
, sanctionsOverride : Authorized
, sanctionsOverrideByName : Maybe String
, sanctionsOverrideAt : Maybe Date
, sanctionsAt : Maybe Date
, frontCameraPath : Maybe String
, frontCameraOverride : Authorized
, frontCameraOverrideByName : Maybe String
, frontCameraOverrideAt : Maybe Date
, frontCameraAt : Maybe Date
, dailyVolume : Maybe String
}
authorizedToString : Authorized -> String
authorizedToString model =
case model of
Verified ->
"verified"
Blocked ->
"blocked"
Automatic ->
"automatic"

55
lamassu-admin-elm/src/Common/Logs/Decoder.elm
View file

@ -1,55 +0,0 @@
module Common.Logs.Decoder exposing (..)
import Json.Decode exposing (..)
import Json.Decode.Extra exposing (date, fromResult)
import Json.Decode.Pipeline exposing (decode, required, optional, hardcoded)
import Common.Logs.Types exposing (..)
logsDecoder : Decoder Logs
logsDecoder =
decode Logs
|> required "logs" (list logDecoder)
|> required "currentMachine" machineDecoder
logDecoder : Decoder Log
logDecoder =
decode Log
|> required "id" string
|> required "timestamp" date
|> required "logLevel" string
|> required "message" string
supportLogsDecoder : Decoder SupportLogs
supportLogsDecoder =
field "supportLogs" (list supportLogDecoder)
latestLogSnapshotDecoder : Decoder SupportLogSnapshot
latestLogSnapshotDecoder =
decode SupportLogSnapshot
|> required "deviceId" string
|> required "timestamp" date
supportLogDecoder : Decoder SupportLog
supportLogDecoder =
decode SupportLog
|> required "id" string
|> required "deviceId" string
|> required "timestamp" date
|> required "name" string
machinesDecoder : Decoder Machines
machinesDecoder =
field "machines" (list machineDecoder)
machineDecoder : Decoder Machine
machineDecoder =
decode Machine
|> required "deviceId" string
|> required "name" string

43
lamassu-admin-elm/src/Common/Logs/Types.elm
View file

@ -1,43 +0,0 @@
module Common.Logs.Types exposing (..)
import Date exposing (Date)
type alias Machine =
{ deviceId : String
, name : String
}
type alias Machines =
List Machine
type alias Log =
{ id : String
, timestamp : Date
, logLevel : String
, message : String
}
type alias SupportLogSnapshot =
{ deviceId : String
, timestamp : Date
}
type alias SupportLog =
{ id : String
, deviceId : String
, timestamp : Date
, name : String
}
type alias SupportLogs =
List SupportLog
type alias Logs =
{ logs : List Log, currentMachine : Machine }

59
lamassu-admin-elm/src/Common/TransactionTypes.elm
View file

@ -1,59 +0,0 @@
module Common.TransactionTypes exposing (..)
import Date exposing (Date)
type CryptoCode
= BTC
| BCH
| ETH
| ZEC
| DASH
| LTC
type alias CashInTxRec =
{ id : String
, machineName : String
, toAddress : String
, cryptoAtoms : Int
, cryptoCode : CryptoCode
, fiat : Float
, commissionPercentage : Maybe Float
, rawTickerPrice : Maybe Float
, fiatCode : String
, txHash : Maybe String
, phone : Maybe String
, error : Maybe String
, operatorCompleted : Bool
, send : Bool
, sendConfirmed : Bool
, expired : Bool
, created : Date
}
type alias CashOutTxRec =
{ id : String
, machineName : String
, toAddress : String
, cryptoAtoms : Int
, cryptoCode : CryptoCode
, fiat : Float
, commissionPercentage : Maybe Float
, rawTickerPrice : Maybe Float
, fiatCode : String
, status : String
, dispense : Bool
, notified : Bool
, redeemed : Bool
, phone : Maybe String
, error : Maybe String
, created : Date
, confirmed : Bool
, expired : Bool
}
type Tx
= CashInTx CashInTxRec
| CashOutTx CashOutTxRec

1856
lamassu-admin-elm/src/Config.elm
View file

File diff suppressed because it is too large Load diff

305
lamassu-admin-elm/src/ConfigDecoder.elm
View file

@ -1,305 +0,0 @@
module ConfigDecoder exposing (..)
import Json.Decode exposing (..)
import ConfigTypes exposing (..)
import Json.Decode.Pipeline exposing (decode, required, optional, hardcoded, custom)
import BasicTypes exposing (..)
fieldValueTypeDecoder : String -> Decoder FieldValue
fieldValueTypeDecoder fieldType =
case fieldType of
"string" ->
map FieldStringValue (field "value" string)
"percentage" ->
map FieldPercentageValue (field "value" float)
"integer" ->
map FieldIntegerValue (field "value" int)
"decimal" ->
map FieldDecimalValue (field "value" float)
"onOff" ->
map FieldOnOffValue (field "value" bool)
"account" ->
map FieldFiatCurrencyValue (field "value" string)
"fiatCurrency" ->
map FieldFiatCurrencyValue (field "value" string)
"cryptoCurrency" ->
map FieldCryptoCurrencyValue (field "value" (list string))
"language" ->
map FieldLanguageValue (field "value" (list string))
"country" ->
map FieldCountryValue (field "value" string)
"textarea" ->
map FieldTextAreaValue (field "value" string)
"markdown" ->
map FieldMarkdownValue (field "value" string)
_ ->
fail ("Unsupported field type: " ++ fieldType)
fieldValueDecoder : Decoder FieldValue
fieldValueDecoder =
(field "fieldType" string) |> andThen fieldValueTypeDecoder
fieldScopeDecoder : Decoder FieldScope
fieldScopeDecoder =
map2 FieldScope
(field "crypto" cryptoDecoder)
(field "machine" machineDecoder)
nullOr : Decoder a -> Decoder (Maybe a)
nullOr decoder =
oneOf
[ null Nothing
, map Just decoder
]
fieldLocatorDecoder : Decoder FieldLocator
fieldLocatorDecoder =
map4 FieldLocator
(field "fieldScope" fieldScopeDecoder)
(field "code" string)
((field "fieldType" string) |> andThen fieldTypeDecoder)
(field "fieldClass" (nullOr string))
fieldDecoder : Decoder Field
fieldDecoder =
map5 Field
(field "fieldLocator" fieldLocatorDecoder)
(field "fieldValue" fieldValueDecoder)
(field "fieldEnabledIfAny" (list string))
(field "fieldEnabledIfAll" (list string))
(succeed True)
string2machine : String -> Machine
string2machine s =
if s == "global" then
GlobalMachine
else
MachineId s
machineDecoder : Decoder Machine
machineDecoder =
map string2machine string
cryptoDecoder : Decoder Crypto
cryptoDecoder =
map stringToCrypto string
displayRecDecoder : Decoder DisplayRec
displayRecDecoder =
map2 DisplayRec
(field "code" string)
(field "display" string)
machineDisplayDecoder : Decoder MachineDisplay
machineDisplayDecoder =
map2 MachineDisplay
(field "machine" machineDecoder)
(field "display" string)
cryptoDisplayDecoder : Decoder CryptoDisplay
cryptoDisplayDecoder =
map2 CryptoDisplay
(field "crypto" cryptoDecoder)
(field "display" string)
stringToConfigScope : String -> Decoder ConfigScope
stringToConfigScope s =
case s of
"global" ->
succeed Global
"specific" ->
succeed Specific
"both" ->
succeed Both
_ ->
fail ("No such ConfigScope " ++ s)
basicFieldTypeDecoder : String -> Decoder FieldType
basicFieldTypeDecoder s =
case s of
"string" ->
succeed FieldStringType
"percentage" ->
succeed FieldPercentageType
"integer" ->
succeed FieldIntegerType
"decimal" ->
succeed FieldDecimalType
"onOff" ->
succeed FieldOnOffType
"account" ->
succeed FieldAccountType
"fiatCurrency" ->
succeed FieldFiatCurrencyType
"cryptoCurrency" ->
succeed FieldCryptoCurrencyType
"language" ->
succeed FieldLanguageType
"country" ->
succeed FieldCountryType
"textarea" ->
succeed FieldTextAreaType
"markdown" ->
succeed FieldMarkdownType
_ ->
fail ("No such FieldType " ++ s)
configScopeDecoder : Decoder ConfigScope
configScopeDecoder =
string
|> andThen stringToConfigScope
fieldTypeDecoder : String -> Decoder FieldType
fieldTypeDecoder fieldType =
basicFieldTypeDecoder fieldType
fieldValidatorDecode : String -> Decoder FieldValidator
fieldValidatorDecode code =
case code of
"min" ->
map FieldMin (field "min" int)
"max" ->
map FieldMax (field "max" int)
"required" ->
succeed FieldRequired
_ ->
fail ("Unsupported fieldValidator: " ++ code)
fieldValidatorDecoder : Decoder FieldValidator
fieldValidatorDecoder =
(field "code" string)
|> andThen fieldValidatorDecode
displayTopDecoderHelper : Maybe Int -> Decoder DisplayTop
displayTopDecoderHelper maybeDisplayTopCount =
case maybeDisplayTopCount of
Nothing ->
(maybe <| (field "displayTop" string))
|> map (DisplayTopSolo << (Maybe.withDefault ""))
Just 0 ->
succeed DisplayTopNone
Just 1 ->
succeed DisplayTopNone
Just x ->
map (DisplayTopLeader x) (field "displayTop" string)
displayTopDecoder : Decoder DisplayTop
displayTopDecoder =
(maybe <| (field "displayTopCount" int))
|> andThen displayTopDecoderHelper
fieldDescriptorDecoder : Decoder FieldDescriptor
fieldDescriptorDecoder =
decode FieldDescriptor
|> required "code" string
|> required "cryptoScope" configScopeDecoder
|> required "machineScope" configScopeDecoder
|> custom displayTopDecoder
|> required "displayBottom" string
|> custom (maybe (field "displayCount" int))
|> custom (field "fieldType" string |> andThen fieldTypeDecoder)
|> custom (field "fieldValidation" <| list fieldValidatorDecoder)
|> required "fieldClass" (nullable string)
|> required "fieldEnabledIfAny" (list string)
|> required "fieldEnabledIfAll" (list string)
|> optional "readOnly" bool False
configSchemaDecoder : Decoder ConfigSchema
configSchemaDecoder =
map5 ConfigSchema
(field "code" string)
(field "display" string)
(field "cryptoScope" configScopeDecoder)
(field "machineScope" configScopeDecoder)
(field "entries" (list fieldDescriptorDecoder))
configGroupDecoder : Decoder ConfigGroup
configGroupDecoder =
map4 ConfigGroup
(field "schema" configSchemaDecoder)
(field "values" (list fieldDecoder))
(field "selectedCryptos" (list string))
(field "data" configDataDecoder)
accountRecDecoder : Decoder AccountRec
accountRecDecoder =
oneOf
[ map4 AccountRec
(field "code" string)
(field "display" string)
(field "class" string)
(field "cryptos" (map Just (list cryptoDecoder)))
, map4 AccountRec
(field "code" string)
(field "display" string)
(field "class" string)
(succeed Nothing)
]
configDataDecoder : Decoder ConfigData
configDataDecoder =
map6 ConfigData
(field "cryptoCurrencies" (list cryptoDisplayDecoder))
(field "currencies" (list displayRecDecoder))
(field "languages" (list displayRecDecoder))
(field "countries" (list displayRecDecoder))
(field "accounts" (list accountRecDecoder))
(field "machines" (list machineDisplayDecoder))

187
lamassu-admin-elm/src/ConfigEncoder.elm
View file

@ -1,187 +0,0 @@
module ConfigEncoder exposing (..)
import Json.Encode exposing (..)
import List
import ConfigTypes exposing (..)
import BasicTypes exposing (..)
encodeFieldValueObject : String -> Value -> Value
encodeFieldValueObject fieldTypeStr value =
object [ ( "fieldType", string fieldTypeStr ), ( "value", value ) ]
encodeFieldValue : FieldValue -> Value
encodeFieldValue fieldValue =
case fieldValue of
FieldStringValue value ->
encodeFieldValueObject "string" (string value)
FieldPercentageValue value ->
encodeFieldValueObject "percentage" (float value)
FieldIntegerValue value ->
encodeFieldValueObject "integer" (int value)
FieldDecimalValue value ->
encodeFieldValueObject "decimal" (float value)
FieldOnOffValue value ->
encodeFieldValueObject "onOff" (bool value)
FieldAccountValue value ->
encodeFieldValueObject "account" (string value)
FieldFiatCurrencyValue value ->
encodeFieldValueObject "fiatCurrency" (string value)
FieldCryptoCurrencyValue value ->
encodeFieldValueObject "cryptoCurrency" (list (List.map string value))
FieldLanguageValue value ->
encodeFieldValueObject "language" (list (List.map string value))
FieldCountryValue value ->
encodeFieldValueObject "country" (string value)
FieldTextAreaValue value ->
encodeFieldValueObject "textarea" (string value)
FieldMarkdownValue value ->
encodeFieldValueObject "markdown" (string value)
encodeCrypto : Crypto -> Value
encodeCrypto crypto =
case crypto of
CryptoCode cryptoCode ->
string cryptoCode
GlobalCrypto ->
string "global"
encodeMachine : Machine -> Value
encodeMachine machine =
case machine of
MachineId machineId ->
string machineId
GlobalMachine ->
string "global"
encodeFieldScope : FieldScope -> Value
encodeFieldScope fieldScope =
Json.Encode.object
[ ( "crypto", encodeCrypto fieldScope.crypto )
, ( "machine", encodeMachine fieldScope.machine )
]
fieldTypeEncoder : FieldType -> Value
fieldTypeEncoder fieldType =
case fieldType of
FieldStringType ->
string "string"
FieldPercentageType ->
string "percentage"
FieldIntegerType ->
string "integer"
FieldDecimalType ->
string "decimal"
FieldOnOffType ->
string "onOff"
FieldAccountType ->
string "account"
FieldFiatCurrencyType ->
string "fiatCurrency"
FieldCryptoCurrencyType ->
string "cryptoCurrency"
FieldLanguageType ->
string "language"
FieldCountryType ->
string "country"
FieldTextAreaType ->
string "textarea"
FieldMarkdownType ->
string "markdown"
maybeString : Maybe String -> Value
maybeString maybeString =
case maybeString of
Nothing ->
null
Just s ->
string s
encodeFieldLocator : FieldLocator -> Value
encodeFieldLocator fieldLocator =
Json.Encode.object
[ ( "fieldScope", encodeFieldScope fieldLocator.fieldScope )
, ( "code", string fieldLocator.code )
, ( "fieldType", fieldTypeEncoder fieldLocator.fieldType )
, ( "fieldClass", maybeString fieldLocator.fieldClass )
]
encodeFieldResult : FieldInstance -> Maybe Value
encodeFieldResult fieldInstance =
let
encode value =
Json.Encode.object
[ ( "fieldLocator", encodeFieldLocator fieldInstance.fieldLocator )
, ( "fieldValue", value )
]
dirtyEncode fieldHolder =
case fieldHolder of
ParsingError fieldValue ->
Nothing
ValidationError fieldValue ->
Nothing
FieldOk fieldValue ->
if (fieldInstance.loadedFieldHolder == fieldHolder) then
Nothing
else
Just <| encode <| encodeFieldValue fieldValue
FieldEmpty ->
if (fieldInstance.loadedFieldHolder == fieldHolder) then
Nothing
else
Just <| encode null
in
dirtyEncode fieldInstance.fieldHolder
encodeResults : String -> List FieldInstance -> Maybe Value
encodeResults configGroupCode fieldInstances =
let
results =
List.filterMap encodeFieldResult fieldInstances
in
if List.isEmpty results then
Nothing
else
Json.Encode.object
[ ( "groupCode", string configGroupCode )
, ( "values", list (List.filterMap encodeFieldResult fieldInstances) )
]
|> Just

495
lamassu-admin-elm/src/ConfigTypes.elm
View file

@ -1,495 +0,0 @@
module ConfigTypes exposing (..)
import String
import Selectize
type alias DisplayRec =
{ code : String
, display : String
}
type Machine
= MachineId String
| GlobalMachine
type alias MachineDisplay =
{ machine : Machine
, display : String
}
type ConfigScope
= Global
| Specific
| Both
type FieldHolder
= ParsingError String
| ValidationError String
| FieldOk FieldValue
| FieldEmpty
type alias FieldScope =
{ crypto : Crypto
, machine : Machine
}
type alias FieldLocator =
{ fieldScope : FieldScope
, code : String
, fieldType : FieldType
, fieldClass : Maybe String
}
type FieldComponent
= InputBoxComponent
| TextAreaComponent
| SelectizeComponent Selectize.State
type alias FieldInstance =
{ fieldLocator : FieldLocator
, component : FieldComponent
, fieldHolder : FieldHolder
, loadedFieldHolder : FieldHolder
, fieldValidation : List FieldValidator
, fieldEnabledIfAny : List String
, fieldEnabledIfAll : List String
, readOnly : Bool
, inScope : Bool
}
type alias ResolvedFieldInstance =
{ fieldLocator : FieldLocator
, fieldValue : Maybe FieldValue
}
type alias Field =
{ fieldLocator : FieldLocator
, fieldValue : FieldValue
, fieldEnabledIfAny : List String
, fieldEnabledIfAll : List String
, inScope : Bool
}
type alias FieldMeta =
{ fieldLocator : FieldLocator
, fieldEnabledIfAny : List String
, fieldEnabledIfAll : List String
, inScope : Bool
}
type FieldType
= FieldStringType
| FieldPercentageType
| FieldIntegerType
| FieldDecimalType
| FieldOnOffType
| FieldAccountType
| FieldFiatCurrencyType
| FieldCryptoCurrencyType
| FieldLanguageType
| FieldCountryType
| FieldTextAreaType
| FieldMarkdownType
type FieldValue
= FieldStringValue String
| FieldPercentageValue Float
| FieldIntegerValue Int
| FieldDecimalValue Float
| FieldOnOffValue Bool
| FieldAccountValue String
| FieldFiatCurrencyValue String
| FieldCryptoCurrencyValue (List String)
| FieldLanguageValue (List String)
| FieldCountryValue String
| FieldTextAreaValue String
| FieldMarkdownValue String
type FieldValidator
= FieldMin Int
| FieldMax Int
| FieldRequired
type DisplayTop
= DisplayTopLeader Int String
| DisplayTopSolo String
| DisplayTopNone
type alias FieldDescriptor =
{ code : String
, cryptoScope : ConfigScope
, machineScope : ConfigScope
, displayTop : DisplayTop
, displayBottom : String
, displayCount : Maybe Int
, fieldType : FieldType
, fieldValidation : List FieldValidator
, fieldClass : Maybe String
, fieldEnabledIfAny : List String
, fieldEnabledIfAll : List String
, readOnly : Bool
}
type alias ConfigSchema =
{ code : String
, display : String
, cryptoScope : ConfigScope
, machineScope : ConfigScope
, entries : List FieldDescriptor
}
type alias ConfigGroup =
{ schema : ConfigSchema
, values : List Field
, selectedCryptos : List String
, data : ConfigData
}
type alias AccountRec =
{ code : String
, display : String
, class : String
, cryptos : Maybe (List Crypto)
}
accountRecToDisplayRec : AccountRec -> DisplayRec
accountRecToDisplayRec accountRec =
{ code = accountRec.code
, display = accountRec.display
}
type alias ConfigData =
{ cryptoCurrencies : List CryptoDisplay
, currencies : List DisplayRec
, languages : List DisplayRec
, countries : List DisplayRec
, accounts : List AccountRec
, machines : List MachineDisplay
}
type alias FieldCollection =
{ fields : List Field
, fieldInstances : List FieldInstance
}
initFieldCollection : FieldCollection
initFieldCollection =
{ fields = []
, fieldInstances = []
}
globalCryptoDisplay : CryptoDisplay
globalCryptoDisplay =
{ crypto = GlobalCrypto
, display = "Global"
}
globalMachineDisplay : MachineDisplay
globalMachineDisplay =
{ machine = GlobalMachine
, display = "Global"
}
fieldValueToDisplay : FieldValue -> String
fieldValueToDisplay fieldValue =
case fieldValue of
FieldOnOffValue v ->
if v then
"On"
else
"Off"
_ ->
fieldValueToString fieldValue
fieldValueToString : FieldValue -> String
fieldValueToString fieldValue =
case fieldValue of
FieldStringValue v ->
v
FieldPercentageValue v ->
toString v
FieldIntegerValue v ->
toString v
FieldDecimalValue v ->
toString v
FieldOnOffValue v ->
if v then
"on"
else
"off"
FieldAccountValue v ->
v
FieldFiatCurrencyValue v ->
v
FieldCryptoCurrencyValue v ->
String.join "," v
FieldLanguageValue v ->
String.join "," v
FieldCountryValue v ->
v
FieldTextAreaValue v ->
v
FieldMarkdownValue v ->
v
machineToString : Machine -> String
machineToString machine =
case machine of
GlobalMachine ->
"global"
MachineId machineId ->
machineId
listMachines : ConfigGroup -> List MachineDisplay
listMachines configGroup =
case configGroup.schema.machineScope of
Specific ->
configGroup.data.machines
Global ->
[ globalMachineDisplay ]
Both ->
globalMachineDisplay :: configGroup.data.machines
isCrypto : String -> CryptoDisplay -> Bool
isCrypto cryptoString cryptoDisplay =
case cryptoDisplay.crypto of
GlobalCrypto ->
cryptoString == "global"
CryptoCode string ->
cryptoString == string
lookupCryptoDisplay : List CryptoDisplay -> String -> Maybe CryptoDisplay
lookupCryptoDisplay cryptoDisplays cryptoString =
List.filter (isCrypto cryptoString) cryptoDisplays
|> List.head
fieldHolderToCryptoStrings : FieldHolder -> List String
fieldHolderToCryptoStrings fieldHolder =
case fieldHolder of
FieldOk fieldValue ->
case fieldValue of
FieldCryptoCurrencyValue cryptoStrings ->
cryptoStrings
_ ->
[]
_ ->
[]
allCryptos : List CryptoDisplay -> ConfigScope -> List String -> List CryptoDisplay
allCryptos cryptoDisplays cryptoScope cryptoStrings =
let
allSpecificCryptos =
List.filterMap (lookupCryptoDisplay cryptoDisplays) cryptoStrings
in
case cryptoScope of
Global ->
[ globalCryptoDisplay ]
Specific ->
allSpecificCryptos
Both ->
globalCryptoDisplay :: allSpecificCryptos
listCryptos : ConfigGroup -> List CryptoDisplay
listCryptos configGroup =
case configGroup.schema.cryptoScope of
Specific ->
configGroup.data.cryptoCurrencies
Global ->
[ globalCryptoDisplay ]
Both ->
globalCryptoDisplay :: configGroup.data.cryptoCurrencies
fieldScopes : ConfigGroup -> List FieldScope
fieldScopes configGroup =
let
machines =
List.map .machine (listMachines configGroup)
cryptos =
List.map .crypto (listCryptos configGroup)
cryptoScopes crypto =
List.map (\machine -> { machine = machine, crypto = crypto }) machines
in
List.concatMap cryptoScopes cryptos
stringToCrypto : String -> Crypto
stringToCrypto string =
case string of
"global" ->
GlobalCrypto
_ ->
CryptoCode string
fieldHolderToMaybe : FieldHolder -> Maybe FieldValue
fieldHolderToMaybe fieldHolder =
case fieldHolder of
FieldOk fieldValue ->
Just fieldValue
_ ->
Nothing
resultToFieldHolder : Result String FieldValue -> FieldHolder
resultToFieldHolder result =
case result of
Ok fieldValue ->
FieldOk fieldValue
Err s ->
ParsingError s
stringToFieldHolder : FieldType -> String -> FieldHolder
stringToFieldHolder fieldType s =
if (String.isEmpty s) then
FieldEmpty
else
case fieldType of
FieldStringType ->
FieldOk (FieldStringValue s)
FieldPercentageType ->
String.toFloat s
|> Result.map FieldPercentageValue
|> resultToFieldHolder
FieldIntegerType ->
String.toInt s
|> Result.map FieldIntegerValue
|> resultToFieldHolder
FieldDecimalType ->
String.toFloat s
|> Result.map FieldDecimalValue
|> resultToFieldHolder
FieldOnOffType ->
case s of
"on" ->
FieldOk (FieldOnOffValue True)
"off" ->
FieldOk (FieldOnOffValue False)
_ ->
ParsingError ("Unsupported value for OnOff: " ++ s)
FieldAccountType ->
FieldOk (FieldAccountValue s)
FieldFiatCurrencyType ->
FieldOk (FieldFiatCurrencyValue s)
FieldCryptoCurrencyType ->
FieldOk (FieldCryptoCurrencyValue [ s ])
FieldLanguageType ->
FieldOk (FieldLanguageValue [ s ])
FieldCountryType ->
FieldOk (FieldCountryValue s)
FieldTextAreaType ->
FieldOk (FieldTextAreaValue s)
FieldMarkdownType ->
FieldOk (FieldMarkdownValue s)
groupMember : ConfigGroup -> String -> Bool
groupMember configGroup fieldCode =
List.any (.code >> ((==) fieldCode)) configGroup.schema.entries
fieldHolderMap : a -> (FieldValue -> a) -> FieldHolder -> a
fieldHolderMap default mapper fieldHolder =
case fieldHolder of
FieldOk v ->
mapper v
_ ->
default
type Crypto
= CryptoCode String
| GlobalCrypto
type alias CryptoDisplay =
{ crypto : Crypto
, display : String
}
cryptoToString : Crypto -> String
cryptoToString crypto =
case crypto of
GlobalCrypto ->
"global"
CryptoCode code ->
code

62
lamassu-admin-elm/src/CoreTypes.elm
View file

@ -1,62 +0,0 @@
module CoreTypes
exposing
( Msg(..)
, Category(..)
, Route(..)
)
import Navigation
import Pair
import Account
import Config
import MaintenanceMachines.Types
import MaintenanceFunding.Types
import Transaction.Types
import Transactions
import Customers.Types
import Customer.Types
import Logs.Types
import SupportLogs.Types
import StatusTypes
type Category
= AccountCat
| MachineSettingsCat
| GlobalSettingsCat
| MaintenanceCat
type Route
= AccountRoute String
| PairRoute
| ConfigRoute String (Maybe String)
| TransactionsRoute
| TransactionRoute String
| CustomersRoute
| CustomerRoute String
| LogsRoute (Maybe String)
| SupportLogsRoute (Maybe String)
| MaintenanceMachinesRoute
| MaintenanceFundingRoute (Maybe String)
| NotFoundRoute
type Msg
= AccountMsg Account.Msg
| PairMsg Pair.Msg
| ConfigMsg Config.Msg
| MaintenanceMachinesMsg MaintenanceMachines.Types.Msg
| MaintenanceFundingMsg MaintenanceFunding.Types.Msg
| TransactionsMsg Transactions.Msg
| TransactionMsg Transaction.Types.Msg
| CustomersMsg Customers.Types.Msg
| CustomerMsg Customer.Types.Msg
| LogsMsg Logs.Types.Msg
| SupportLogsMsg SupportLogs.Types.Msg
| LoadAccounts (List ( String, String ))
| LoadStatus StatusTypes.WebStatus
| NewUrl String
| UrlChange Navigation.Location
| Interval
| WebSocketMsg String

35
lamassu-admin-elm/src/Css/Admin.elm
View file

@ -1,35 +0,0 @@
module Css.Admin exposing (className, class, classList, id)
import Css.Helpers
import Html
import Html.CssHelpers
name : String
name =
"lamassuAdmin"
helpers : Html.CssHelpers.Namespace String class id msg
helpers =
Html.CssHelpers.withNamespace name
className : class -> String
className class =
Css.Helpers.identifierToString name class
class : List class -> Html.Attribute msg
class =
helpers.class
classList : List ( class, Bool ) -> Html.Attribute msg
classList =
helpers.classList
id : id -> Html.Attribute msg
id =
helpers.id

83
lamassu-admin-elm/src/Css/Classes.elm
View file

@ -1,83 +0,0 @@
module Css.Classes exposing (..)
type CssClasses
= Layout
| Main
| PaneWrapper
| LeftPane
| ContentPane
| NavBar
| MainLeft
| MainRight
| NavBarItemActive
| NavBarCategoryContainer
| NavBarCategory
| NavBarRoute
| Container
| Content
| CryptoTabs
| CryptoTab
| CryptoTabsActive
| SectionLabel
| ConfigTable
| ConfigTableGlobalRow
| ConfigContainer
| TopDisplay
| BottomDisplay
| MultiDisplay
| ShortCell
| MediumCell
| LongCell
| TextCell
| FormRow
| Button
| ButtonRow
| Active
| BasicInput
| BasicInputDisabled
| BasicInputReadOnly
| CellDisabled
| NoInput
| Component
| FocusedComponent
| InvalidComponent
| TableButton
| Fail
| Success
| StatusBar
| InvalidGroup
| NumberColumn
| DirectionColumn
| TruncatedColumn
| DateColumn
| TxTable
| InputContainer
| UnitDisplay
| EmptyTable
| Saving
| Enabled
| Disabled
| TxId
| TxDate
| TxMachine
| TxAmount
| TxFiat
| TxCrypto
| TxPhone
| TxAddress
| TxCancelled
| QrCode
| CashOut
| CashIn
| ReadOnly
| CryptoAddress
| BalanceSection
| Textarea
| SelectizeAccount
| SelectizeFiatCurrency
| SelectizeCryptoCurrency
| SelectizeLanguage
| SelectizeCountry
| SelectizeOnOff

72
lamassu-admin-elm/src/Css/ColorSchemes.elm
View file

@ -1,72 +0,0 @@
module Css.ColorSchemes exposing (..)
import Css exposing (..)
import Css.LocalColors as Colors
import Css.Classes exposing (..)
type alias ColorScheme =
{ bg : Color
, fg : Color
, bgHover : Color
, fgActive : Color
, bgActive : Color
}
darkGreyScheme : ColorScheme
darkGreyScheme =
{ bg = Colors.darkGrey
, fg = Colors.sandstone
, bgHover = Colors.darkerGrey
, fgActive = Colors.amazonite
, bgActive = Colors.darkerGrey
}
darkerGreyScheme : ColorScheme
darkerGreyScheme =
{ bg = Colors.darkerGrey
, fg = Colors.sandstone
, bgHover = Colors.darkerGrey
, fgActive = Colors.amazonite
, bgActive = Colors.darkerGrey
}
lightGreyScheme : ColorScheme
lightGreyScheme =
{ bg = Colors.darkerLightGrey
, fg = Colors.sandstone
, bgHover = Colors.lighterLightGrey
, fgActive = Colors.sandstone
, bgActive = Colors.lightGrey
}
cobaltScheme : ColorScheme
cobaltScheme =
{ bg = Colors.cobalt
, fg = Colors.white
, bgHover = Colors.darkCobalt
, fgActive = Colors.amazonite
, bgActive = Colors.darkCobalt
}
colorize : ColorScheme -> Style
colorize scheme =
batch
[ color scheme.fg
, fontWeight bold
, cursor pointer
, backgroundColor scheme.bg
, hover
[ backgroundColor scheme.bgHover
]
, active [ color scheme.fgActive ]
, withClass Active
[ color scheme.fgActive
, backgroundColor scheme.bgActive
]
]

68
lamassu-admin-elm/src/Css/LocalColors.elm
View file

@ -1,68 +0,0 @@
module Css.LocalColors exposing (..)
import Css exposing (..)
cobalt : Color
cobalt =
hex "004062"
darkCobalt : Color
darkCobalt =
hex "042c47"
amazonite : Color
amazonite =
hex "37e8d7"
white : Color
white =
hex "ffffff"
sandstone : Color
sandstone =
hex "5f5f56"
lightGrey : Color
lightGrey =
hex "f6f6f4"
lighterLightGrey : Color
lighterLightGrey =
hex "fcfcfa"
darkerLightGrey : Color
darkerLightGrey =
hex "E6E6E3"
darkGrey : Color
darkGrey =
hex "2d2d2d"
darkerGrey : Color
darkerGrey =
hex "282828"
red : Color
red =
hex "eb6b6e"
lightRed : Color
lightRed =
hex "efd1d2"
disabledGrey : Color
disabledGrey =
hex "757575"

523
lamassu-admin-elm/src/Css/Main.elm
View file

@ -1,523 +0,0 @@
module Css.Main exposing (..)
import Css exposing (..)
import Css.Elements
exposing
( body
, li
, a
, div
, td
, th
, tr
, thead
, tbody
, input
, button
, label
, p
, svg
, h2
)
import Css.Namespace exposing (namespace)
import Css.LocalColors as Colors
import Css.ColorSchemes exposing (..)
import Css.Classes exposing (..)
import Css.Selectize
type CssIds
= Page
mainBackgroundColor : Color
mainBackgroundColor =
Colors.lightGrey
contentBackgroundColor : Color
contentBackgroundColor =
Colors.white
navBackgroundColor : Color
navBackgroundColor =
Colors.darkGrey
navItemActiveBackgroundColor : Color
navItemActiveBackgroundColor =
Colors.darkerGrey
navItemActiveColor : Color
navItemActiveColor =
Colors.amazonite
navItemColor : Color
navItemColor =
Colors.sandstone
cryptoTabsBackgroundColor : Color
cryptoTabsBackgroundColor =
Colors.cobalt
cryptoTabsHoverBackgroundColor : Color
cryptoTabsHoverBackgroundColor =
Colors.darkCobalt
cryptoTabsColor : Color
cryptoTabsColor =
Colors.white
cryptoTabsActiveColor : Color
cryptoTabsActiveColor =
Colors.amazonite
cobaltBG : Color
cobaltBG =
Colors.cobalt
cobaltHoverBG : Color
cobaltHoverBG =
Colors.darkCobalt
cobaltColor : Color
cobaltColor =
Colors.white
cobaltActiveColor : Color
cobaltActiveColor =
Colors.amazonite
codeFonts : List String
codeFonts =
[ "Inconsolata", "monospace" ]
css : Stylesheet
css =
(stylesheet << namespace "lamassuAdmin")
[ body
[ fontFamilies [ "Nunito", "sans-serif" ]
, margin zero
]
, p
[ margin zero ]
, class QrCode
[ backgroundColor Colors.lightGrey
, padding (px 10)
, marginBottom (px 20)
, borderRadius (px 6)
, descendants
[ svg
[ height (px 400)
, width (px 400)
]
]
]
, class Layout
[]
, class Main
[ displayFlex
, marginBottom (px 40)
]
, class PaneWrapper
[ displayFlex
]
, class LeftPane
[ minWidth (px 270)
]
, class ContentPane
[ maxHeight (pct 100)
]
, class StatusBar
[ position fixed
, bottom zero
, padding2 (px 10) (px 20)
, backgroundColor Colors.sandstone
, color Colors.white
, width (pct 100)
]
, class CashOut
[ backgroundColor Colors.lightGrey
]
, class FormRow
[ margin2 (px 20) zero
, firstChild
[ margin zero
]
, descendants
[ label
[ fontSize (px 11)
, fontWeight bold
, children
[ div
[ margin3 zero zero (px 5)
, color Colors.sandstone
]
]
]
, input
[ border zero
, backgroundColor Colors.white
, borderRadius (px 3)
, padding (px 6)
, textAlign left
, fontFamilies codeFonts
, fontSize (px 14)
, fontWeight (int 600)
, width (pct 90)
, property "outline" "none"
]
]
]
, class ButtonRow
[ textAlign right ]
, class Button
[ colorize cobaltScheme
, padding2 (px 10) (px 15)
, display inlineBlock
, borderRadius (px 5)
, withClass Disabled
[ backgroundColor Colors.darkerLightGrey
, color Colors.white
, cursor default
]
]
, class MainLeft
[ backgroundColor navBackgroundColor
, height (pct 100)
]
, class MainRight
[ backgroundColor mainBackgroundColor
, height (pct 100)
]
, class Content
[ margin (px 20)
, backgroundColor contentBackgroundColor
, borderRadius (px 5)
]
, class Container
[ padding (px 30)
, backgroundColor Colors.lightGrey
, borderRadius4 (px 0) (px 5) (px 5) (px 5)
, width (em 30)
]
, class CryptoAddress
[ fontFamilies codeFonts ]
, class BalanceSection
[ marginTop (em 2)
, descendants
[ h2
[ fontSize (em 1.2)
, marginBottom (em 0.2)
]
]
]
, class Textarea
[ width (pct 100)
, border (px 0)
, backgroundColor transparent
]
, class CryptoTabs
[ displayFlex
, children
[ class CryptoTab
[ padding2 (px 10) (px 15)
, colorize lightGreyScheme
, textDecoration none
, firstChild
[ borderRadius4 (px 5) (px 0) (px 0) (px 0)
]
, lastChild
[ borderRadius4 (px 0) (px 5) (px 0) (px 0)
]
]
]
]
, class SectionLabel
[ fontWeight bold
, fontSize (px 30)
, marginBottom (px 10)
]
, class ConfigContainer
[ padding2 (px 20) (px 60)
, borderRadius4 (px 0) (px 7) (px 7) (px 7)
, backgroundColor mainBackgroundColor
, margin3 zero zero (px 10)
, property "animation" "fadein 0.8s"
, overflow hidden
, minHeight (em 15)
, minWidth (em 20)
]
, class NoInput
[ fontFamilies codeFonts
, color Colors.sandstone
, fontWeight normal
, textAlign left |> important
]
, class TxTable
[ borderRadius (px 7)
, margin2 (px 20) zero
, property "border-collapse" "collapse"
, fontSize (px 14)
, width (pct 100)
, backgroundColor Colors.white
, descendants
[ a
[ textDecoration none
, color Colors.sandstone
, borderBottom3 (px 1) solid Colors.amazonite
]
, class NumberColumn
[ textAlign right
, width (em 10)
]
, class DirectionColumn
[ textAlign left
, fontWeight bold
, fontSize (pct 90)
]
, class TxCancelled
[ backgroundColor Colors.lightRed ]
, tbody
[ fontFamilies codeFonts
, color Colors.sandstone
, descendants
[ td
[ padding2 (px 2) (px 14)
, borderBottom3 (px 1) solid Colors.lightGrey
, whiteSpace noWrap
]
, class TruncatedColumn
[ maxWidth zero
, overflow hidden
, width (px 300)
, textOverflow ellipsis
]
, class TxDate [ width (em 10) ]
, class TxAddress
[ width (em 25)
]
]
]
, thead
[ fontSize (px 14)
, textAlign center
, color Colors.sandstone
, descendants
[ td
[ borderBottom3 (px 2) solid Colors.lightGrey
, padding (px 5)
]
]
]
]
]
, class EmptyTable
[ fontSize (px 20)
, fontWeight normal
]
, class ConfigTable
[ fontSize (px 14)
, fontWeight bold
, borderRadius (px 7)
, margin2 (px 20) zero
, property "border-collapse" "collapse"
, descendants
[ class Css.Selectize.SelectizeContainer
[ Css.Selectize.component
, border3 (px 2) solid Colors.darkerLightGrey
, borderRadius (px 3)
]
, class InputContainer
[ displayFlex
, property "justify-content" "flex-end"
, border3 (px 2) solid Colors.darkerLightGrey
, borderRadius (px 3)
]
, class UnitDisplay
[ backgroundColor Colors.darkerLightGrey
, color Colors.sandstone
, padding2 zero (px 5)
, fontWeight (int 700)
, fontSize (pct 80)
, lineHeight (px 25)
, cursor default
, fontFamilies [ "Nunito", "sans-serif" ]
]
, input
[ border zero
, borderRadius (px 3)
, padding (px 6)
, textAlign right
, width (pct 100)
, fontFamilies codeFonts
, fontWeight (int 600)
, fontSize (px 14)
, outline none
, backgroundColor Colors.white
]
, class CellDisabled
[ property "background" "repeating-linear-gradient(45deg,#dfdfdc,#dfdfdc 2px,#e6e6e3 5px)"
]
, class BasicInput
[ pseudoElement "placeholder"
[ color Colors.amazonite
, opacity (num 1)
]
]
, class BasicInputDisabled
[ height (px 25)
, lineHeight (px 25)
, fontSize (px 14)
, fontWeight (int 500)
, color Colors.sandstone
, opacity (num 0.7)
, textAlign left
, padding2 zero (em 1)
, property "background" "repeating-linear-gradient(45deg,#dfdfdc,#dfdfdc 2px,#e6e6e3 5px)"
]
, class ReadOnly
[ lineHeight (px 25)
, backgroundColor Colors.lightGrey
, fontFamilies codeFonts
, fontSize (px 14)
, fontWeight (int 600)
, color Colors.sandstone
, cursor default
, children
[ class BasicInputReadOnly
[ padding2 zero (px 5)
]
]
]
, td
[ padding2 (px 3) (px 4)
, textAlign center
, verticalAlign middle
, width (em 5)
]
, class Component
[ borderRadius (px 3)
, border3 (px 2) solid Colors.lightGrey
, backgroundColor Colors.white
]
, class FocusedComponent
[ children
[ class InputContainer
[ borderColor Colors.amazonite ]
]
]
, class InvalidComponent
[ children
[ class InputContainer [ borderColor Colors.red ]
, class Css.Selectize.SelectizeContainer [ borderColor Colors.red ]
]
, descendants
[ input
[ color Colors.red
]
]
]
, tbody
[ descendants
[ td
[ textAlign right
, whiteSpace noWrap
]
, td
[ firstChild
[ fontWeight normal
]
]
]
]
, thead
[ fontWeight bold
, textAlign left
]
, class MultiDisplay
[ backgroundColor Colors.darkerLightGrey
, borderLeft3 (px 3) solid Colors.lightGrey
, borderRight3 (px 3) solid Colors.lightGrey
, borderRadius (px 3)
]
, th
[ padding2 (px 3) (px 4)
, textAlign center
]
, class ConfigTableGlobalRow
[ descendants
[ td
[ firstChild
[ fontWeight bold
]
]
]
]
, class TextCell
[ textAlign left ]
, class ShortCell
[ minWidth (em 5) ]
, class MediumCell
[ minWidth (em 10) ]
, class LongCell
[ minWidth (em 20) ]
]
]
, class Saving
[ fontSize (px 18)
, fontWeight normal
, textAlign right
]
, class NavBar
[ margin zero
, padding4 zero zero (px 110) zero
, backgroundColor Colors.darkGrey
, fontSize (px 18)
, width (em 15)
, maxWidth (em 15)
, minWidth (em 15)
, height (pct 100)
, descendants
[ class NavBarRoute
[ height (px 60)
, display block
, lineHeight (px 60)
, padding2 (px 0) (px 20)
, colorize darkGreyScheme
]
, class NavBarCategory
[ height (px 60)
, display block
, lineHeight (px 60)
, padding2 (px 0) (px 20)
, colorize darkGreyScheme
]
, class InvalidGroup
[ color Colors.red |> important ]
, class NavBarCategoryContainer
[ descendants
[ class NavBarRoute
[ colorize darkGreyScheme
, padding4 zero (px 20) zero (px 30)
, fontWeight (int 500)
, property "animation" "fadein 0.8s"
]
]
]
]
]
]

164
lamassu-admin-elm/src/Css/Selectize.elm
View file

@ -1,164 +0,0 @@
module Css.Selectize exposing (..)
import Css exposing (..)
import Css.LocalColors as Colors
import Selectize
import Css.Admin exposing (className)
import Css.Elements exposing (input)
import Css.Classes as C
codeFonts : List String
codeFonts =
[ "Inconsolata", "monospace" ]
component : Style
component =
batch
[ borderRadius (px 3)
, position relative
, margin zero
, descendants
[ class NoOptions
[ backgroundColor Colors.lighterLightGrey
, fontSize (px 14)
, fontWeight (int 500)
, color Colors.sandstone
, padding (px 5)
, textAlign center
, cursor default
, property "-webkit-user-select" "none"
]
, class SelectBox
[ displayFlex
, alignItems center
, padding2 zero (px 5)
, property "background-color" "inherit"
, width (px 60)
]
, class BoxContainer
[ position absolute
, property "z-index" "100"
, left (px -3)
, backgroundColor Colors.white
, textAlign left
, fontWeight (int 500)
, fontSize (pct 80)
, borderRadius (px 3)
, backgroundColor Colors.white
, border3 (px 2) solid Colors.darkerLightGrey
, borderTop zero
, color Colors.sandstone
, width (em 15)
, cursor pointer
, padding (px 5)
]
, class BoxItems
[]
, class BoxItemActive
[ color Colors.cobalt
, fontWeight (int 900)
]
, class BoxItem
[ padding2 (px 3) (px 6)
, overflow hidden
, textOverflow ellipsis
]
, class Info
[ padding2 (px 3) (px 6)
, color Colors.darkGrey
]
, class MultiItemContainer
[ descendants
[ class SelectedItem
[ backgroundColor Colors.cobalt
, color Colors.white
, padding (px 2)
, margin2 zero (px 1)
, fontFamilies codeFonts
, fontSize (pct 70)
, fontWeight normal
, borderRadius (px 3)
]
, class FallbackItem
[ backgroundColor Colors.amazonite
]
]
]
, class SingleItemContainer
[ descendants
[ class SelectedItem
[ fontFamilies codeFonts
, fontSize (px 14)
, padding zero
, borderRadius zero
]
, class FallbackItem
[ color Colors.sandstone
]
]
]
, class C.SelectizeLanguage
[ descendants
[ class SelectBox
[ width (px 140)
]
]
]
, class C.SelectizeCryptoCurrency
[ descendants
[ class SelectBox
[ width (px 150)
]
]
]
, input
[ textAlign left
, property "background-color" "inherit"
, padding2 (px 6) (px 2)
, width (em 6)
, cursor default
]
]
]
type Class
= SelectizeContainer
| SelectBox
| BoxItems
| BoxItem
| BoxItemActive
| SelectedItems
| FallbackItems
| FallbackItem
| SelectedItem
| InputEditing
| SingleItemContainer
| MultiItemContainer
| BoxContainer
| Info
| InfoNoMatches
| NoOptions
| Disabled
classes : Selectize.HtmlClasses
classes =
{ container = className SelectizeContainer
, singleItemContainer = className SingleItemContainer
, multiItemContainer = className MultiItemContainer
, selectBox = className SelectBox
, selectedItems = className SelectedItems
, fallbackItems = className FallbackItems
, fallbackItem = className FallbackItem
, selectedItem = className SelectedItem
, boxContainer = className BoxContainer
, boxItems = className BoxItems
, boxItem = className BoxItem
, boxItemActive = className BoxItemActive
, info = className Info
, infoNoMatches = className InfoNoMatches
, inputEditing = className InputEditing
, noOptions = className NoOptions
}

24
lamassu-admin-elm/src/Customer/Rest.elm
View file

@ -1,24 +0,0 @@
module Customer.Rest exposing (..)
import RemoteData exposing (..)
import Http
import HttpBuilder exposing (..)
import Common.Customer.Decoder exposing (customerDecoder)
import Common.Customer.Types exposing (..)
import Customer.Types exposing (..)
patchCustomer : String -> String -> Authorized -> Cmd Msg
patchCustomer id field value =
patch ("/api/customer/" ++ id ++ "?" ++ field ++ "=" ++ authorizedToString value)
|> withExpect (Http.expectJson customerDecoder)
|> send RemoteData.fromResult
|> Cmd.map Load
getCustomer : String -> Cmd Msg
getCustomer id =
get ("/api/customer/" ++ id)
|> withExpect (Http.expectJson customerDecoder)
|> send RemoteData.fromResult
|> Cmd.map Load

25
lamassu-admin-elm/src/Customer/State.elm
View file

@ -1,25 +0,0 @@
module Customer.State exposing (..)
import RemoteData exposing (..)
import Customer.Rest exposing (..)
import Customer.Types exposing (..)
init : Model
init =
NotAsked
load : String -> ( Model, Cmd Msg )
load id =
( Loading, getCustomer id )
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
Load loadedModel ->
loadedModel ! []
PatchCustomer id fieldName value ->
model ! [ patchCustomer id fieldName value ]

13
lamassu-admin-elm/src/Customer/Types.elm
View file

@ -1,13 +0,0 @@
module Customer.Types exposing (..)
import RemoteData exposing (..)
import Common.Customer.Types exposing (..)
type alias Model =
RemoteData.WebData Customer
type Msg
= Load Model
| PatchCustomer String String Authorized

210
lamassu-admin-elm/src/Customer/View.elm
View file

@ -1,210 +0,0 @@
module Customer.View exposing (..)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
import RemoteData exposing (..)
import Css.Admin as CSSAdmin exposing (..)
import Css.Classes as C
import Common.Customer.Types exposing (..)
import Customer.Types exposing (..)
import Date exposing (..)
import Date.Extra exposing (toFormattedString)
customerActions : String -> Authorized -> Html Msg
customerActions id authorizedOverride =
case authorizedOverride of
Blocked ->
button [ onClick (PatchCustomer id "authorizedOverride" Verified) ] [ text "Unblock" ]
Verified ->
button [ onClick (PatchCustomer id "authorizedOverride" Blocked) ] [ text "Block" ]
Automatic ->
button [ onClick (PatchCustomer id "authorizedOverride" Blocked) ] [ text "Block" ]
formatDate : Maybe Date -> String
formatDate date =
case date of
Just date ->
toFormattedString "yyyy-MM-dd HH:mm" date
Nothing ->
""
maybeText : Maybe String -> Html Msg
maybeText maybeString =
text (Maybe.withDefault "" maybeString)
actions : String -> String -> Authorized -> Html Msg
actions id fieldKey checkedValue =
(div []
[ div []
[ radio fieldKey checkedValue Automatic (PatchCustomer id fieldKey Automatic)
, radio fieldKey checkedValue Blocked (PatchCustomer id fieldKey Blocked)
, radio fieldKey checkedValue Verified (PatchCustomer id fieldKey Verified)
]
]
)
radio : String -> Authorized -> Authorized -> msg -> Html msg
radio inputName checkedValue value msg =
label
[ style [ ( "padding", "5px" ) ] ]
[ input [ checked (checkedValue == value), type_ "radio", name inputName, onClick msg ] []
, text (authorizedToString value)
]
verifyStatus : Maybe a -> Authorized -> Html Msg
verifyStatus complianceType fieldOverride =
if fieldOverride == Verified || (complianceType /= Nothing && fieldOverride == Automatic) then
text "Verified"
else
text "Unverified"
customerView : Customer -> Html Msg
customerView customer =
div []
[ h1 [] [ text "Customer Details" ]
, table [ CSSAdmin.class [ C.TxTable ] ]
[ tbody []
[ tr []
[ td [] [ text "Customer ID" ]
, td [] [ text customer.id ]
]
, tr []
[ td [] [ text "Name" ]
, td [] [ maybeText customer.name ]
]
, tr []
[ td [] [ text "Phone" ]
, td [] [ maybeText customer.phone ]
]
, tr []
[ td [] [ text "Completed phone at" ]
, td [] [ text (formatDate customer.phoneAt) ]
]
, tr []
[ td [] [ text "Created" ]
, td [] [ text (toFormattedString "yyyy-MM-dd HH:mm" customer.created) ]
]
, tr []
[ td [] [ text "Block Customer" ]
, td []
[ customerActions customer.id customer.authorizedOverride ]
]
, tr []
[ td [] [ text "Authorized at " ]
, td [] [ text (formatDate customer.authorizedAt) ]
]
, tr []
[ td [] [ text "Daily Volume " ]
, td [] [ maybeText customer.dailyVolume ]
]
]
]
, h2 [] [ text "Compliance types" ]
, table [ CSSAdmin.class [ C.TxTable ] ]
[ thead []
[ tr []
[ td [] [ text "Name" ]
, td [] [ text "Date" ]
, td [] [ text "Verify Status" ]
, td [] [ text "Override Status" ]
, td [] [ text "User who overrode" ]
, td [] [ text "Actions" ]
]
]
, tbody []
[ tr []
[ td [] [ text "SMS" ]
, td [] [ text (formatDate customer.phoneAt) ]
, td [] [ verifyStatus customer.phone customer.smsOverride ]
, td [] [ text (authorizedToString customer.smsOverride) ]
, td [] [ maybeText customer.smsOverrideByName ]
, td [] [ actions customer.id "smsOverride" customer.smsOverride ]
]
, tr []
[ td [] [ text "ID Card Data" ]
, td [] [ text (formatDate customer.idCardDataAt) ]
, td [] [ verifyStatus customer.idCardData customer.idCardDataOverride ]
, td [] [ text (authorizedToString customer.idCardDataOverride) ]
, td [] [ maybeText customer.idCardDataOverrideByName ]
, td [] [ actions customer.id "idCardDataOverride" customer.idCardDataOverride ]
]
, tr []
[ td [] [ text "ID Card Photo" ]
, td [] [ text (formatDate customer.idCardPhotoAt) ]
, td [] [ verifyStatus customer.idCardPhotoPath customer.idCardPhotoOverride ]
, td [] [ text (authorizedToString customer.idCardPhotoOverride) ]
, td [] [ maybeText customer.idCardPhotoOverrideByName ]
, td [] [ actions customer.id "idCardPhotoOverride" customer.idCardPhotoOverride ]
]
, tr []
[ td [] [ text "Front Facing Camera" ]
, td [] [ text (formatDate customer.frontCameraAt) ]
, td [] [ verifyStatus customer.frontCameraPath customer.frontCameraOverride ]
, td [] [ text (authorizedToString customer.frontCameraOverride) ]
, td [] [ maybeText customer.frontCameraOverrideByName ]
, td [] [ actions customer.id "frontCameraOverride" customer.frontCameraOverride ]
]
, tr []
[ td [] [ text "Sanctions Check" ]
, td [] [ text (formatDate customer.sanctionsAt) ]
, td [] [ verifyStatus customer.sanctions customer.sanctionsOverride ]
, td [] [ text (authorizedToString customer.sanctionsOverride) ]
, td [] [ maybeText customer.sanctionsOverrideByName ]
, td [] [ actions customer.id "sanctionsOverride" customer.sanctionsOverride ]
]
]
]
, h2 [] [ text "ID Card Photo" ]
, case customer.idCardPhotoPath of
Nothing ->
text "N/A"
Just idCardPhotoPath ->
div []
[ img
[ src ("/id-card-photo/" ++ idCardPhotoPath)
, height 200
, alt "N/A"
] []
]
, h2 [] [ text "Front Facing Camera Photo" ]
, case customer.frontCameraPath of
Nothing ->
text "N/A"
Just frontCameraPath ->
div []
[ img
[ src ("/front-camera-photo/" ++ frontCameraPath)
, height 200
, alt "N/A"
] []
]
]
view : Model -> Html Msg
view model =
case model of
NotAsked ->
div [] []
Loading ->
div [] [ text "Loading..." ]
Failure err ->
div [] [ text (toString err) ]
Success customer ->
div [] [ customerView customer ]

15
lamassu-admin-elm/src/Customers/Rest.elm
View file

@ -1,15 +0,0 @@
module Customers.Rest exposing (..)
import RemoteData exposing (..)
import Http
import HttpBuilder exposing (..)
import Common.Customer.Decoder exposing (customersDecoder)
import Customers.Types exposing (..)
getCustomers : Cmd Msg
getCustomers =
get ("/api/customers")
|> withExpect (Http.expectJson customersDecoder)
|> send RemoteData.fromResult
|> Cmd.map Load

27
lamassu-admin-elm/src/Customers/State.elm
View file

@ -1,27 +0,0 @@
module Customers.State exposing (..)
import RemoteData exposing (..)
import Customers.Rest exposing (..)
import Customers.Types exposing (..)
init : Model
init =
NotAsked
loadCmd : Cmd Msg
loadCmd =
getCustomers
load : ( Model, Cmd Msg )
load =
( Loading, loadCmd )
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
Load loadedModel ->
loadedModel ! []

12
lamassu-admin-elm/src/Customers/Types.elm
View file

@ -1,12 +0,0 @@
module Customers.Types exposing (..)
import RemoteData exposing (..)
import Common.Customer.Types exposing (..)
type alias Model =
RemoteData.WebData Customers
type Msg
= Load Model

70
lamassu-admin-elm/src/Customers/View.elm
View file

@ -1,70 +0,0 @@
module Customers.View exposing (..)
import Html exposing (..)
import Html.Attributes exposing (colspan, href)
import Css.Admin exposing (..)
import Css.Classes as C
import RemoteData exposing (..)
import List
import Common.Customer.Types exposing (..)
import Customers.Types exposing (..)
import Date.Extra exposing (toFormattedString)
customerLink : String -> Html Msg
customerLink id =
a [ href ("/#customer/" ++ id) ] [ text (String.left 8 id) ]
maybeText : Maybe String -> Html Msg
maybeText maybeString =
text (Maybe.withDefault "" maybeString)
rowView : Customer -> Html Msg
rowView customer =
tr [ class [] ]
[ td [] [ customerLink customer.id ]
, td [] [ text (toFormattedString "yyyy-MM-dd HH:mm" customer.created) ]
, td [] [ maybeText customer.phone ]
, td [] [ maybeText customer.name ]
, td [] [ maybeText customer.status ]
]
tableView : Customers -> Html Msg
tableView customers =
if List.isEmpty customers then
div [] [ text "No customers yet." ]
else
div []
[ h1 [] [ text "Customers" ]
, table [ class [ C.TxTable ] ]
[ thead []
[ tr []
[ td [] [ text "Id" ]
, td [] [ text "Created" ]
, td [] [ text "Phone" ]
, td [] [ text "Name" ]
, td [] [ text "Status" ]
]
]
, tbody [] (List.map rowView customers)
]
]
view : Model -> Html Msg
view model =
case model of
NotAsked ->
div [] []
Loading ->
div [] [ text "Loading..." ]
Failure err ->
div [] [ text (toString err) ]
Success customers ->
div [] [ tableView customers ]

95
lamassu-admin-elm/src/FieldSet/Rest.elm
View file

@ -1,95 +0,0 @@
module FieldSet.Rest exposing (..)
import Json.Decode as D
import Json.Encode as E
import FieldSet.Types exposing (..)
fieldPasswordDecoder : Bool -> FieldValue
fieldPasswordDecoder present =
if present then
FieldPassword PasswordHidden
else
FieldPassword PasswordEmpty
badInt : D.Decoder Int
badInt =
D.oneOf [ D.int ]
fieldValueDecoder : String -> D.Decoder FieldValue
fieldValueDecoder fieldType =
case fieldType of
"string" ->
D.map FieldString D.string
"password" ->
D.map fieldPasswordDecoder D.bool
"integer" ->
D.map FieldInteger badInt
_ ->
D.fail ("Unsupported field type: " ++ fieldType)
fieldDecoder : D.Decoder Field
fieldDecoder =
(D.field "fieldType" D.string)
|> D.andThen
(\fieldType ->
D.map6 Field
(D.field "code" D.string)
(D.field "display" D.string)
(D.oneOf [ D.field "placeholder" D.string, D.succeed "" ])
(D.field "required" D.bool)
(D.field "value" (fieldValueDecoder fieldType))
(D.field "value" (fieldValueDecoder fieldType))
)
encodeFieldValue : FieldValue -> E.Value
encodeFieldValue fieldValue =
case fieldValue of
FieldString value ->
E.string value
FieldPassword value ->
case value of
Password s ->
E.string s
_ ->
E.null
FieldInteger value ->
E.int value
maybeString : Maybe String -> E.Value
maybeString maybeString =
case maybeString of
Nothing ->
E.null
Just s ->
E.string s
encodeField : Field -> Maybe E.Value
encodeField field =
if isDirty field then
Just
(E.object
[ ( "code", E.string field.code )
, ( "value", encodeFieldValue field.value )
]
)
else
Nothing
isDirty : Field -> Bool
isDirty field =
field.value /= field.loadedValue

23
lamassu-admin-elm/src/FieldSet/State.elm
View file

@ -1,23 +0,0 @@
module FieldSet.State exposing (update)
import FieldSet.Types exposing (..)
updateField : String -> String -> Field -> Field
updateField fieldCode fieldValueString field =
if .code field == fieldCode then
{ field | value = updateFieldValue fieldValueString field.value }
else
field
updateFieldSet : String -> String -> List Field -> List Field
updateFieldSet fieldCode fieldValueString fields =
List.map (updateField fieldCode fieldValueString) fields
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
Input fieldCode valueString ->
updateFieldSet fieldCode valueString model ! []

44
lamassu-admin-elm/src/FieldSet/Types.elm
View file

@ -1,44 +0,0 @@
module FieldSet.Types exposing (..)
type alias Model =
List Field
type Msg
= Input String String
type alias Field =
{ code : String
, display : String
, placeholder : String
, required : Bool
, value : FieldValue
, loadedValue : FieldValue
}
type FieldPasswordType
= Password String
| PasswordEmpty
| PasswordHidden
type FieldValue
= FieldString String
| FieldPassword FieldPasswordType
| FieldInteger Int
updateFieldValue : String -> FieldValue -> FieldValue
updateFieldValue stringValue oldFieldValue =
case oldFieldValue of
FieldString _ ->
FieldString stringValue
FieldPassword _ ->
FieldPassword (Password stringValue)
FieldInteger oldValue ->
FieldInteger <| Result.withDefault oldValue <| String.toInt stringValue

52
lamassu-admin-elm/src/FieldSet/View.elm
View file

@ -1,52 +0,0 @@
module FieldSet.View exposing (view)
import Html exposing (..)
import Html.Attributes as HA exposing (defaultValue, name, type_, placeholder)
import Html.Events exposing (..)
import FieldSet.Types exposing (..)
import List
import Css.Admin exposing (..)
import Css.Classes as C
fieldComponent : Field -> Html Msg
fieldComponent field =
let
inputEl =
case field.value of
FieldString string ->
input
[ onInput (Input field.code), placeholder field.placeholder, defaultValue string ]
[]
FieldPassword pass ->
case pass of
PasswordEmpty ->
input
[ onInput (Input field.code), name field.code, type_ "password" ]
[]
_ ->
input
[ onInput (Input field.code), name field.code, type_ "password", placeholder "••• Field is set •••" ]
[]
FieldInteger int ->
input
[ onInput (Input field.code), type_ "number", defaultValue (toString int) ]
[]
in
label []
[ div [] [ text field.display ]
, inputEl
]
fieldView : Field -> Html Msg
fieldView field =
div [ class [ C.FormRow ] ] [ fieldComponent field ]
view : Model -> Html Msg
view model =
div [ class [ C.ConfigContainer ] ] (List.map fieldView model)

48
lamassu-admin-elm/src/FuzzyMatch.elm
View file

@ -1,48 +0,0 @@
module FuzzyMatch exposing (match)
import String
import Fuzzy
import Tuple
clean : String -> String
clean s =
String.trim s
|> String.toLower
type alias DisplayRec =
{ code : String
, display : String
}
score : String -> Int -> DisplayRec -> ( ( Int, Int ), DisplayRec )
score needle index hay =
let
match keyword =
Fuzzy.match [] [] needle keyword
|> .score
score =
List.map match ((String.split " " (clean hay.display)) ++ [ clean hay.code, clean hay.display ])
|> List.minimum
|> Maybe.withDefault
10000
in
( ( score, index ), hay )
match : String -> List DisplayRec -> List DisplayRec
match rawString list =
let
s =
clean rawString
in
if String.isEmpty s then
list
else
List.indexedMap (score s) list
|> List.sortBy Tuple.first
|> List.filter (((>) 1100) << Tuple.first << Tuple.first)
|> List.map Tuple.second

153
lamassu-admin-elm/src/Lamassu.elm
View file

@ -1,153 +0,0 @@
module Main exposing (..)
import Html exposing (Html, Attribute, a, div, hr, input, span, text, map)
import Html.Attributes exposing (class)
import Navigation
import SupportLogs.Types
import SupportLogs.State
import SupportLogs.View
import UrlParser exposing ((</>), s, string, top, parseHash)
import Navigation exposing (newUrl, Location)
import StatusTypes exposing (..)
type Category
= AccountCat
| MachineSettingsCat
| GlobalSettingsCat
| MaintenanceCat
type Route
= SupportLogsRoute (Maybe String)
| NotFoundRoute
type Msg
= SupportLogsMsg SupportLogs.Types.Msg
| UrlChange Navigation.Location
main : Program Never Model Msg
main =
Navigation.program UrlChange
{ init = init
, update = update
, view = view
, subscriptions = subscriptions
}
-- URL PARSERS
parseRoute : UrlParser.Parser (Route -> a) a
parseRoute =
UrlParser.oneOf
[ UrlParser.map (\id -> SupportLogsRoute (Just id)) (s "support_logs" </> string)
, UrlParser.map (SupportLogsRoute Nothing) (s "support_logs")
]
-- MODEL
type alias Model =
{ location : Location
, supportLogs : SupportLogs.Types.Model
, status : Maybe StatusRec
, err : Maybe String
}
init : Location -> ( Model, Cmd Msg )
init location =
let
model =
{ location = location
, supportLogs = SupportLogs.State.init
, status = Nothing
, err = Nothing
}
( newModel, newCmd ) =
urlUpdate location model
in
newModel ! [ newCmd ]
-- UPDATE
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
SupportLogsMsg supportLogsMsg ->
let
( supportLogsModel, cmd ) =
SupportLogs.State.update supportLogsMsg model.supportLogs
in
{ model | supportLogs = supportLogsModel } ! [ Cmd.map SupportLogsMsg cmd ]
UrlChange location ->
urlUpdate location model
content : Model -> Route -> Html Msg
content model route =
case route of
SupportLogsRoute _ ->
map SupportLogsMsg (SupportLogs.View.view model.supportLogs)
NotFoundRoute ->
div [] [ text ("No such route") ]
view : Model -> Html Msg
view model =
let
route =
Maybe.withDefault NotFoundRoute (parseHash parseRoute model.location)
invalidConfigGroups =
Maybe.map .invalidConfigGroups model.status
|> Maybe.withDefault []
in
div [ class "lamassuAdminLayout" ]
[ div
[ class "lamassuAdminMain" ]
[ div [ class "lamassuAdminContent" ]
[ content model route ]
]
]
urlUpdate : Location -> Model -> ( Model, Cmd Msg )
urlUpdate location model =
let
route =
Maybe.withDefault NotFoundRoute (parseHash parseRoute location)
in
case route of
SupportLogsRoute maybeId ->
let
( supportLogsModel, cmd ) =
SupportLogs.State.load maybeId
in
{ model | location = location, supportLogs = supportLogsModel } ! [ Cmd.map SupportLogsMsg cmd ]
NotFoundRoute ->
{ model | location = location } ! []
-- SUBSCRIPTIONS
subscriptions : Model -> Sub Msg
subscriptions model =
Sub.batch
[]

22
lamassu-admin-elm/src/LamassuAdminServerClient.elm
View file

@ -1,22 +0,0 @@
module ClientServerWebsocket exposing (..)
import RemoteData exposing (..)
import HttpBuilder exposing (..)
-- Fetch stuff: different configurations for starters
type alias NewsResponse =
()
type alias Msg =
NewsResponse (WebData News)
getNews : Cmd Msg
getNews =
Http.get decodeNews "/news"
|> RemoteData.asCmd
|> Cmd.map NewsResponse

29
lamassu-admin-elm/src/Logs/Rest.elm
View file

@ -1,29 +0,0 @@
module Logs.Rest exposing (..)
import RemoteData exposing (..)
import Http
import HttpBuilder exposing (..)
import Common.Logs.Decoder exposing (logsDecoder, machinesDecoder, latestLogSnapshotDecoder)
import Logs.Types exposing (..)
getLogs : Maybe String -> Cmd Msg
getLogs maybeId =
Http.get ("/api/logs/" ++ (Maybe.withDefault "" maybeId)) logsDecoder
|> RemoteData.sendRequest
|> Cmd.map LoadLogs
getMachines : Cmd Msg
getMachines =
Http.get "/api/machines/" machinesDecoder
|> RemoteData.sendRequest
|> Cmd.map LoadMachines
shareLogs : String -> Cmd Msg
shareLogs id =
post ("/api/support_logs?deviceId=" ++ id)
|> withExpect (Http.expectJson latestLogSnapshotDecoder)
|> send RemoteData.fromResult
|> Cmd.map LoadSupportLog

42
lamassu-admin-elm/src/Logs/State.elm
View file

@ -1,42 +0,0 @@
module Logs.State exposing (..)
import RemoteData exposing (..)
import Logs.Rest exposing (..)
import Logs.Types exposing (..)
init : Model
init =
{ logs = NotAsked, machines = NotAsked, latestLogSnapshot = NotAsked }
load : Maybe String -> ( Model, Cmd Msg )
load maybeId =
( { logs = Loading, machines = Loading, latestLogSnapshot = NotAsked }, getData maybeId )
getData : Maybe String -> Cmd Msg
getData maybeId =
Cmd.batch [ getLogs maybeId, getMachines ]
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
LoadLogs response ->
( { model | logs = response }
, Cmd.none
)
LoadMachines response ->
( { model | machines = response }
, Cmd.none
)
ShareLogs machine ->
model ! [ shareLogs machine.deviceId ]
LoadSupportLog supportLog ->
( { model | latestLogSnapshot = supportLog }
, Cmd.none
)

18
lamassu-admin-elm/src/Logs/Types.elm
View file

@ -1,18 +0,0 @@
module Logs.Types exposing (..)
import RemoteData exposing (..)
import Common.Logs.Types exposing (..)
type alias Model =
{ logs : WebData Logs
, machines : WebData Machines
, latestLogSnapshot : WebData SupportLogSnapshot
}
type Msg
= LoadLogs (WebData Logs)
| LoadMachines (WebData Machines)
| ShareLogs Machine
| LoadSupportLog (WebData SupportLogSnapshot)

149
lamassu-admin-elm/src/Logs/View.elm
View file

@ -1,149 +0,0 @@
module Logs.View exposing (..)
import Html exposing (..)
import Html.Attributes exposing (href)
import Html.Events exposing (onClick)
import Css.Admin exposing (..)
import Css.Classes as C
import RemoteData exposing (..)
import List
import Common.Logs.Types exposing (..)
import Logs.Types exposing (..)
import Date exposing (..)
import Date.Extra exposing (toFormattedString)
machineLink : Machine -> Html Msg
machineLink machine =
a [ href ("/#logs/" ++ machine.deviceId) ] [ text machine.name ]
logsActions : Logs -> Html Msg
logsActions logs =
button [ onClick (ShareLogs logs.currentMachine) ] [ text "Share log snapshot" ]
formatDate : Date -> String
formatDate date =
toFormattedString "yyyy-MM-dd HH:mm" date
rowView : Log -> Html Msg
rowView log =
tr [ class [] ]
[ td [] [ text (formatDate log.timestamp) ]
, td [] [ text log.logLevel ]
, td [] [ text log.message ]
]
machineRowView : Machine -> Html Msg
machineRowView machine =
tr [ class [] ]
[ td [] [ machineLink machine ]
]
machineItemView : Machine -> Html Msg
machineItemView machine =
li [] [ machineLink machine ]
machinesView : Machines -> Html Msg
machinesView machines =
if List.isEmpty machines then
div [ class [ C.EmptyTable ] ] [ text "No paired machines." ]
else
div []
[ div [ class [ C.TxTable ] ]
[ ul [] (List.map machineItemView machines)
]
]
machines : Model -> Html Msg
machines model =
case model.machines of
NotAsked ->
div [] []
Loading ->
div [] [ text "Loading machines ..." ]
Failure err ->
div [] [ text (toString err) ]
Success machines ->
div [] [ machinesView machines ]
latestLogSnapshot : Model -> Html Msg
latestLogSnapshot model =
case model.latestLogSnapshot of
NotAsked ->
div [] []
Loading ->
div [] []
Failure err ->
div [] [ text (toString err) ]
Success latestLogSnapshot ->
h4 [] [ text "✓ Saved latest snapshot" ]
logsView : Logs -> Html Msg
logsView logs =
if List.isEmpty logs.logs then
div [] [ text "No logs yet." ]
else
div []
[ logsActions logs
, table [ class [ C.TxTable ] ]
[ thead []
[ tr []
[ td [] [ text "Date" ]
, td [] [ text "Level" ]
, td [] [ text "Message" ]
]
]
, tbody [] (List.map rowView logs.logs)
]
]
logs : Model -> Html Msg
logs model =
case model.logs of
NotAsked ->
div [] []
Loading ->
div [] [ text "Loading logs..." ]
Failure err ->
div [] [ text (toString err) ]
Success logs ->
div []
[ logsView logs
]
view : Model -> Html Msg
view model =
div []
[ h1 [] [ text "Latest Logs" ]
, div [ class [ C.PaneWrapper ] ]
[ div [ class [ C.LeftPane ] ]
[ h2 [] [ text "Machines" ]
, machines model
]
, div [ class [ C.ContentPane ] ]
[ h2 [] [ text "Logs" ]
, latestLogSnapshot model
, logs model
]
]
]

479
lamassu-admin-elm/src/Main.elm
View file

@ -1,479 +0,0 @@
module Main exposing (..)
import Html exposing (Html, Attribute, a, div, hr, input, span, text, map)
import Html.Attributes exposing (class)
import Navigation
import Pair
import Account
import Config
import Transactions
import Customers.Types
import Customers.State
import Customers.View
import Logs.Types
import Logs.State
import Logs.View
import SupportLogs.Types
import SupportLogs.State
import SupportLogs.View
import Customer.Types
import Customer.State
import Customer.View
import MaintenanceFunding.Types
import NavBar exposing (..)
import UrlParser exposing ((</>), s, string, top, parseHash)
import Http
import HttpBuilder exposing (..)
import RemoteData
import Navigation exposing (newUrl, Location)
import CoreTypes exposing (Msg(..), Route(..), Category(..))
import AccountsDecoder exposing (accountsDecoder)
import StatusTypes exposing (..)
import StatusDecoder exposing (..)
import Time exposing (..)
import Css.Admin
import Css.Classes as C
import Markdown
import MaintenanceMachines.Types
import MaintenanceMachines.State
import MaintenanceMachines.View
import MaintenanceFunding.Types
import MaintenanceFunding.State
import MaintenanceFunding.View
import Transaction.Types
import Transaction.State
import Transaction.View
main : Program Never Model Msg
main =
Navigation.program UrlChange
{ init = init
, update = update
, view = view
, subscriptions = subscriptions
}
-- URL PARSERS
parseRoute : UrlParser.Parser (Route -> a) a
parseRoute =
UrlParser.oneOf
[ UrlParser.map AccountRoute (s "account" </> string)
, UrlParser.map PairRoute (s "pair")
, UrlParser.map (\config crypto -> ConfigRoute config (Just crypto)) (s "config" </> string </> string)
, UrlParser.map (\config -> ConfigRoute config Nothing) (s "config" </> string)
, UrlParser.map MaintenanceMachinesRoute (s "machines")
, UrlParser.map (\crypto -> MaintenanceFundingRoute (Just crypto)) (s "funding" </> string)
, UrlParser.map (MaintenanceFundingRoute Nothing) (s "funding")
, UrlParser.map TransactionsRoute (s "transactions")
, UrlParser.map TransactionRoute (s "transaction" </> string)
, UrlParser.map CustomersRoute (s "customers")
, UrlParser.map CustomerRoute (s "customer" </> string)
, UrlParser.map (\id -> LogsRoute (Just id)) (s "logs" </> string)
, UrlParser.map (LogsRoute Nothing) (s "logs")
, UrlParser.map (\id -> SupportLogsRoute (Just id)) (s "support_logs" </> string)
, UrlParser.map (SupportLogsRoute Nothing) (s "support_logs")
, UrlParser.map (ConfigRoute "setup" Nothing) top
]
getAccounts : Cmd Msg
getAccounts =
get ("/api/accounts")
|> withExpect (Http.expectJson accountsDecoder)
|> send RemoteData.fromResult
|> Cmd.map (RemoteData.withDefault [])
|> Cmd.map LoadAccounts
getStatus : Cmd Msg
getStatus =
get ("/api/status/")
|> withExpect (Http.expectJson statusDecoder)
|> send RemoteData.fromResult
|> Cmd.map LoadStatus
-- MODEL
type alias Model =
{ location : Location
, pair : Pair.Model
, account : Account.Model
, config : Config.Model
, maintenanceMachines : MaintenanceMachines.Types.Model
, maintenanceFunding : MaintenanceFunding.Types.Model
, transactions : Transactions.Model
, transaction : Transaction.Types.Model
, customers : Customers.Types.Model
, customer : Customer.Types.Model
, logs : Logs.Types.Model
, supportLogs : SupportLogs.Types.Model
, accounts : List ( String, String )
, status : Maybe StatusRec
, err : Maybe String
}
init : Location -> ( Model, Cmd Msg )
init location =
let
model =
{ location = location
, account = Account.init
, pair = Pair.init False
, config = Config.init
, maintenanceMachines = MaintenanceMachines.State.init
, maintenanceFunding = MaintenanceFunding.State.init
, transactions = Transactions.init
, transaction = Transaction.State.init
, customers = Customers.State.init
, customer = Customer.State.init
, logs = Logs.State.init
, supportLogs = SupportLogs.State.init
, accounts = []
, status = Nothing
, err = Nothing
}
( newModel, newCmd ) =
urlUpdate location model
in
newModel ! [ newCmd, getAccounts, getStatus ]
-- UPDATE
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
PairMsg pairMsg ->
let
( pairModel, cmd ) =
Pair.update pairMsg model.pair
in
{ model | pair = pairModel } ! [ Cmd.map PairMsg cmd ]
AccountMsg accountMsg ->
let
( accountModel, cmd ) =
Account.update accountMsg model.account
in
{ model | account = accountModel } ! [ Cmd.map AccountMsg cmd ]
ConfigMsg configMsg ->
let
( configModel, cmd ) =
Config.update configMsg model.config
loaded =
Config.loaded configMsg
extraCmds =
if loaded then
[ getAccounts, getStatus ]
else
[]
in
{ model | config = configModel } ! ([ Cmd.map ConfigMsg cmd ] ++ extraCmds)
MaintenanceMachinesMsg maintenanceMachinesMsg ->
let
( maintenanceMachines, cmd ) =
MaintenanceMachines.State.update maintenanceMachinesMsg model.maintenanceMachines
in
{ model | maintenanceMachines = maintenanceMachines } ! [ Cmd.map MaintenanceMachinesMsg cmd ]
MaintenanceFundingMsg maintenanceFundingMsg ->
let
( maintenanceFunding, cmd ) =
MaintenanceFunding.State.update maintenanceFundingMsg model.maintenanceFunding
in
{ model | maintenanceFunding = maintenanceFunding } ! [ Cmd.map MaintenanceFundingMsg cmd ]
TransactionsMsg transactionsMsg ->
let
( transactionsModel, cmd ) =
Transactions.update transactionsMsg model.transactions
in
{ model | transactions = transactionsModel } ! [ Cmd.map TransactionsMsg cmd ]
TransactionMsg transactionMsg ->
let
( transaction, cmd ) =
Transaction.State.update transactionMsg model.transaction
in
{ model | transaction = transaction } ! [ Cmd.map TransactionMsg cmd ]
CustomersMsg customersMsg ->
let
( customersModel, cmd ) =
Customers.State.update customersMsg model.customers
in
{ model | customers = customersModel } ! [ Cmd.map CustomersMsg cmd ]
CustomerMsg customerMsg ->
let
( customerModel, cmd ) =
Customer.State.update customerMsg model.customer
in
{ model | customer = customerModel } ! [ Cmd.map CustomerMsg cmd ]
LogsMsg logsMsg ->
let
( logsModel, cmd ) =
Logs.State.update logsMsg model.logs
in
{ model | logs = logsModel } ! [ Cmd.map LogsMsg cmd ]
SupportLogsMsg supportLogsMsg ->
let
( supportLogsModel, cmd ) =
SupportLogs.State.update supportLogsMsg model.supportLogs
in
{ model | supportLogs = supportLogsModel } ! [ Cmd.map SupportLogsMsg cmd ]
LoadAccounts accounts ->
{ model | accounts = accounts } ! []
LoadStatus webStatus ->
let
newStatus =
List.filterMap identity [ RemoteData.toMaybe webStatus, model.status ]
|> List.head
serverStatus =
Maybe.withDefault False <| Maybe.map (\status -> status.server.up) newStatus
newPair =
Pair.updateStatus serverStatus model.pair
rates =
Maybe.withDefault [] <| Maybe.map (\status -> status.server.rates) newStatus
newConfig =
Config.updateRates rates model.config
in
{ model | status = newStatus, pair = newPair, config = newConfig } ! []
NewUrl url ->
let
( configModel, configCmd ) =
Config.submitNoLoad model.config
in
{ model | config = configModel } ! [ Navigation.newUrl url, Cmd.map ConfigMsg configCmd ]
UrlChange location ->
urlUpdate location model
Interval ->
let
route =
Maybe.withDefault NotFoundRoute (parseHash parseRoute model.location)
extraCmds =
if route == TransactionsRoute then
[ Cmd.map TransactionsMsg Transactions.loadCmd ]
else
[]
in
model ! ([ getStatus ] ++ extraCmds)
WebSocketMsg msg ->
model ! []
content : Model -> Route -> Html Msg
content model route =
case route of
PairRoute ->
map PairMsg (Pair.view model.pair)
AccountRoute _ ->
map AccountMsg (Account.view model.account)
ConfigRoute _ _ ->
map ConfigMsg (Config.view model.config)
MaintenanceMachinesRoute ->
map MaintenanceMachinesMsg (MaintenanceMachines.View.view model.maintenanceMachines)
MaintenanceFundingRoute _ ->
map MaintenanceFundingMsg (MaintenanceFunding.View.view model.maintenanceFunding)
TransactionsRoute ->
map TransactionsMsg (Transactions.view model.transactions)
TransactionRoute _ ->
map TransactionMsg (Transaction.View.view model.transaction)
CustomersRoute ->
map CustomersMsg (Customers.View.view model.customers)
CustomerRoute _ ->
map CustomerMsg (Customer.View.view model.customer)
LogsRoute _ ->
map LogsMsg (Logs.View.view model.logs)
SupportLogsRoute _ ->
map SupportLogsMsg (SupportLogs.View.view model.supportLogs)
NotFoundRoute ->
div [] [ text ("No such route") ]
statusBar : Maybe StatusRec -> Html Msg
statusBar maybeStatus =
case maybeStatus of
Nothing ->
div [ Css.Admin.class [ C.StatusBar ] ] [ text "Loading ..." ]
Just status ->
let
serverStatus =
if not status.server.wasConfigured then
[ Markdown.toHtml [] "**lamassu-server** not configured yet" ]
else if status.server.up then
[ Markdown.toHtml [] ("**lamassu-server** is up **/** " ++ status.server.machineStatus) ]
else
case status.server.lastPing of
Nothing ->
[ Markdown.toHtml [] "**lamassu-server** not up yet" ]
Just lastPing ->
[ Markdown.toHtml [] ("**lamassu-server** has been down for " ++ lastPing) ]
in
div [ Css.Admin.class [ C.StatusBar ] ] serverStatus
view : Model -> Html Msg
view model =
let
route =
Maybe.withDefault NotFoundRoute (parseHash parseRoute model.location)
invalidConfigGroups =
Maybe.map .invalidConfigGroups model.status
|> Maybe.withDefault []
in
div [ class "lamassuAdminLayout" ]
[ div
[ class "lamassuAdminMain" ]
[ NavBar.view route invalidConfigGroups
, div [ class "lamassuAdminContent" ]
[ content model route ]
]
, statusBar model.status
]
urlUpdate : Location -> Model -> ( Model, Cmd Msg )
urlUpdate location model =
let
route =
Maybe.withDefault NotFoundRoute (parseHash parseRoute location)
in
case route of
PairRoute ->
case model.status of
Just status ->
{ model | location = location, pair = Pair.init status.server.up } ! []
Nothing ->
{ model | location = location, pair = Pair.init False } ! []
AccountRoute account ->
let
( accountModel, cmd ) =
Account.load account
in
{ model | location = location, account = accountModel } ! [ Cmd.map AccountMsg cmd ]
ConfigRoute config maybeCryptoCodeString ->
let
( configModel, cmd ) =
Config.load model.config config maybeCryptoCodeString
in
{ model | location = location, config = configModel } ! [ Cmd.map ConfigMsg cmd ]
MaintenanceMachinesRoute ->
let
( maintenanceMachines, cmd ) =
MaintenanceMachines.State.load
in
{ model | location = location, maintenanceMachines = maintenanceMachines }
! [ Cmd.map MaintenanceMachinesMsg cmd ]
MaintenanceFundingRoute maybeCrypto ->
let
( maintenanceFunding, cmd ) =
MaintenanceFunding.State.load maybeCrypto
in
{ model | location = location, maintenanceFunding = maintenanceFunding }
! [ Cmd.map MaintenanceFundingMsg cmd ]
TransactionsRoute ->
let
( transactionsModel, cmd ) =
Transactions.load
in
{ model | location = location, transactions = transactionsModel } ! [ Cmd.map TransactionsMsg cmd ]
CustomersRoute ->
let
( customersModel, cmd ) =
Customers.State.load
in
{ model | location = location, customers = customersModel } ! [ Cmd.map CustomersMsg cmd ]
CustomerRoute id ->
let
( customerModel, cmd ) =
Customer.State.load id
in
{ model | location = location, customer = customerModel } ! [ Cmd.map CustomerMsg cmd ]
LogsRoute maybeId ->
let
( logsModel, cmd ) =
Logs.State.load maybeId
in
{ model | location = location, logs = logsModel } ! [ Cmd.map LogsMsg cmd ]
SupportLogsRoute maybeId ->
let
( supportLogsModel, cmd ) =
SupportLogs.State.load maybeId
in
{ model | location = location, supportLogs = supportLogsModel } ! [ Cmd.map SupportLogsMsg cmd ]
TransactionRoute txId ->
let
( transaction, cmd ) =
Transaction.State.load txId
in
{ model | location = location, transaction = transaction }
! [ Cmd.map TransactionMsg cmd ]
NotFoundRoute ->
{ model | location = location } ! []
-- SUBSCRIPTIONS
subscriptions : Model -> Sub Msg
subscriptions model =
Sub.batch
[ every (5 * second) (\_ -> Interval)
]

38
lamassu-admin-elm/src/MaintenanceFunding/Rest.elm
View file

@ -1,38 +0,0 @@
module MaintenanceFunding.Rest exposing (..)
import RemoteData exposing (..)
import HttpBuilder exposing (..)
import Json.Decode as D
import Json.Decode.Pipeline exposing (decode, required)
import Http
import HttpBuilder exposing (..)
import MaintenanceFunding.Types exposing (..)
getForm : Maybe String -> Cmd Msg
getForm maybeCrypto =
get ("/api/funding/" ++ (Maybe.withDefault "" maybeCrypto))
|> withExpect (Http.expectJson subModelDecoder)
|> send RemoteData.fromResult
|> Cmd.map Load
cryptoDisplayDecoder : D.Decoder CryptoDisplay
cryptoDisplayDecoder =
decode CryptoDisplay
|> required "cryptoCode" D.string
|> required "display" D.string
subModelDecoder : D.Decoder SubModel
subModelDecoder =
decode SubModel
|> required "cryptoCode" D.string
|> required "cryptoDisplays" (D.list cryptoDisplayDecoder)
|> required "fundingAddress" D.string
|> required "fundingAddressUrl" D.string
|> required "confirmedBalance" D.string
|> required "pending" D.string
|> required "fiatConfirmedBalance" D.string
|> required "fiatPending" D.string
|> required "fiatCode" D.string

35
lamassu-admin-elm/src/MaintenanceFunding/State.elm
View file

@ -1,35 +0,0 @@
module MaintenanceFunding.State exposing (..)
import MaintenanceFunding.Rest exposing (..)
import MaintenanceFunding.Types exposing (..)
import RemoteData exposing (..)
init : Model
init =
NotAsked
load : Maybe String -> ( Model, Cmd Msg )
load maybeCrypto =
( Loading, getForm maybeCrypto )
fundingUpdate : SubModel -> ( SubModel, Cmd Msg )
fundingUpdate model =
model ! []
switchCrypto : String -> Model -> ( Model, Cmd Msg )
switchCrypto crypto model =
( Loading, getForm (Just crypto) )
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
Load newModel ->
RemoteData.update fundingUpdate newModel
CryptoSwitch crypto ->
switchCrypto crypto model

31
lamassu-admin-elm/src/MaintenanceFunding/Types.elm
View file

@ -1,31 +0,0 @@
module MaintenanceFunding.Types exposing (..)
import RemoteData exposing (..)
type alias CryptoDisplay =
{ cryptoCode : String
, display : String
}
type alias SubModel =
{ cryptoCode : String
, cryptoDisplays : List CryptoDisplay
, fundingAddress : String
, fundingAddressUrl : String
, confirmedBalance : String
, pending : String
, fiatConfirmedBalance : String
, fiatPending : String
, fiatCode : String
}
type alias Model =
RemoteData.WebData SubModel
type Msg
= Load Model
| CryptoSwitch String

82
lamassu-admin-elm/src/MaintenanceFunding/View.elm
View file

@ -1,82 +0,0 @@
module MaintenanceFunding.View exposing (..)
import Html exposing (..)
import Html.Attributes exposing (href)
import RemoteData exposing (..)
import MaintenanceFunding.Types exposing (..)
import QRCode
import QRCode.ECLevel as ECLevel
import Css.Admin exposing (..)
import Css.Classes as C
qrCode : String -> Html msg
qrCode s =
let
resultQRCode =
QRCode.toSvgWithECLevel s ECLevel.L
in
case resultQRCode of
Result.Ok view ->
view
Result.Err err ->
Html.text (toString err)
fundingView : SubModel -> Html Msg
fundingView subModel =
div []
[ cryptosView subModel.cryptoDisplays (Just subModel.cryptoCode)
, section [ class [ C.Container ] ]
[ div [] [ text ("Deposit " ++ subModel.cryptoCode ++ " to this address.") ]
, div [] [ qrCode subModel.fundingAddressUrl ]
, div [ class [ C.CryptoAddress ] ] [ text subModel.fundingAddress ]
, section [ class [ C.BalanceSection ] ]
[ h2 [] [ text "Balance" ]
, div [] [ text (subModel.confirmedBalance ++ " " ++ subModel.cryptoCode ++ " (" ++ subModel.pending ++ " pending)") ]
, div [] [ text (subModel.fiatConfirmedBalance ++ " " ++ subModel.fiatCode ++ " (" ++ subModel.fiatPending ++ " pending)") ]
]
]
]
cryptoView : Maybe String -> CryptoDisplay -> Html Msg
cryptoView maybeActiveCrypto cryptoDisplay =
let
activeClass =
case maybeActiveCrypto of
Nothing ->
class []
Just activeCrypto ->
if (activeCrypto == cryptoDisplay.cryptoCode) then
class [ C.Active ]
else
class []
url =
"/#funding/" ++ cryptoDisplay.cryptoCode
in
a [ activeClass, class [ C.CryptoTab ], href url ] [ text cryptoDisplay.display ]
cryptosView : List CryptoDisplay -> Maybe String -> Html Msg
cryptosView cryptos activeCrypto =
nav [ class [ C.CryptoTabs ] ] (List.map (cryptoView activeCrypto) cryptos)
view : Model -> Html Msg
view model =
case model of
NotAsked ->
div [] []
Loading ->
div [] [ text "Loading..." ]
Failure err ->
div [] [ text (toString err) ]
Success subModel ->
fundingView subModel

79
lamassu-admin-elm/src/MaintenanceMachines/Rest.elm
View file

@ -1,79 +0,0 @@
module MaintenanceMachines.Rest exposing (..)
import RemoteData exposing (..)
import HttpBuilder exposing (..)
import Json.Decode as D
import Json.Encode as E
import Http
import HttpBuilder exposing (..)
import MaintenanceMachines.Types exposing (..)
import BasicTypes exposing (..)
toModel : SavingStatus -> Machines -> SubModel
toModel status machines =
{ status = status, machines = machines }
getForm : Cmd Msg
getForm =
get ("/api/machines")
|> withExpect (Http.expectJson machinesDecoder)
|> send (Result.map (toModel NotSaving) >> RemoteData.fromResult)
|> Cmd.map Load
postForm : MachineAction -> Cmd Msg
postForm action =
post "/api/machines"
|> withJsonBody (encodeAction action)
|> withExpect (Http.expectJson machinesDecoder)
|> send (Result.map (toModel Saved) >> RemoteData.fromResult)
|> Cmd.map Load
machineDecoder : D.Decoder Machine
machineDecoder =
D.map7 Machine
(D.field "deviceId" D.string)
(D.field "name" D.string)
(D.field "cashbox" D.int)
(D.field "cassette1" D.int)
(D.field "cassette2" D.int)
(D.field "paired" D.bool)
(D.field "cashOut" D.bool)
machinesDecoder : D.Decoder Machines
machinesDecoder =
D.map identity
(D.field "machines" (D.list machineDecoder))
encodeAction : MachineAction -> E.Value
encodeAction action =
case action of
ResetCashOutBills machine ->
E.object
[ ( "action", E.string "resetCashOutBills" )
, ( "deviceId", E.string machine.deviceId )
, ( "cassettes", E.list [ E.int machine.cassette1, E.int machine.cassette2 ] )
]
UnpairMachine machine ->
E.object
[ ( "action", E.string "unpair" )
, ( "deviceId", E.string machine.deviceId )
]
RebootMachine machine ->
E.object
[ ( "action", E.string "reboot" )
, ( "deviceId", E.string machine.deviceId )
]
RestartServices machine ->
E.object
[ ( "action", E.string "restartServices" )
, ( "deviceId", E.string machine.deviceId )
]

91
lamassu-admin-elm/src/MaintenanceMachines/State.elm
View file

@ -1,91 +0,0 @@
module MaintenanceMachines.State exposing (..)
import RemoteData exposing (..)
import String
import List
import Process
import Task
import Time exposing (second)
import MaintenanceMachines.Types exposing (..)
import MaintenanceMachines.Rest exposing (..)
import BasicTypes exposing (..)
init : Model
init =
NotAsked
load : ( Model, Cmd Msg )
load =
( Loading, getForm )
updateMachine : Machine -> Machine -> Machine
updateMachine machine oldMachine =
if machine.deviceId == oldMachine.deviceId then
machine
else
oldMachine
updateCassette : Machine -> Position -> String -> SubModel -> ( SubModel, Cmd Msg )
updateCassette machine position str subModel =
let
countResult =
String.toInt str
updatedMachine =
case countResult of
Ok count ->
case position of
Top ->
{ machine | cassette1 = count }
Bottom ->
{ machine | cassette2 = count }
Err _ ->
machine
machines =
List.map (updateMachine updatedMachine) subModel.machines
in
{ subModel | machines = machines } ! []
updateAction : MachineAction -> SubModel -> ( SubModel, Cmd Msg )
updateAction action subModel =
subModel ! [ postForm action ]
saveUpdate : SubModel -> ( SubModel, Cmd Msg )
saveUpdate model =
let
cmd =
if (model.status == Saved) then
Process.sleep (2 * second)
|> Task.perform (\_ -> HideSaveIndication)
else
Cmd.none
in
model ! [ cmd ]
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
Action ->
model ! []
Load newModel ->
RemoteData.update saveUpdate newModel
InputCassette machine position str ->
RemoteData.update (updateCassette machine position str) model
Submit action ->
RemoteData.update (updateAction action) model
HideSaveIndication ->
RemoteData.update (\subModel -> { subModel | status = NotSaving } ! []) model

49
lamassu-admin-elm/src/MaintenanceMachines/Types.elm
View file

@ -1,49 +0,0 @@
module MaintenanceMachines.Types exposing (..)
import RemoteData exposing (..)
import BasicTypes exposing (..)
type alias SubModel =
{ status : SavingStatus
, machines : Machines
}
type alias Model =
RemoteData.WebData SubModel
type alias Machine =
{ deviceId : String
, name : String
, cashbox : Int
, cassette1 : Int
, cassette2 : Int
, paired : Bool
, cashOut : Bool
}
type alias Machines =
List Machine
type MachineAction
= ResetCashOutBills Machine
| UnpairMachine Machine
| RebootMachine Machine
| RestartServices Machine
type Msg
= Action
| Load Model
| InputCassette Machine Position String
| Submit MachineAction
| HideSaveIndication
type Position
= Top
| Bottom

114
lamassu-admin-elm/src/MaintenanceMachines/View.elm
View file

@ -1,114 +0,0 @@
module MaintenanceMachines.View exposing (..)
import Html exposing (..)
import Html.Attributes exposing (defaultValue)
import Html.Events exposing (onClick, onInput)
import Css.Admin exposing (..)
import Css.Classes as C
import List
import RemoteData exposing (..)
import MaintenanceMachines.Types exposing (..)
import BasicTypes exposing (..)
inputCassetteView : Machine -> Position -> Int -> Html Msg
inputCassetteView machine position count =
input
[ class [ C.BasicInput ]
, onInput (InputCassette machine position)
, defaultValue (toString count)
]
[]
rowView : Machine -> Html Msg
rowView machine =
let
resetBills =
if machine.cashOut then
td []
[ button [ class [ C.TableButton ], onClick (Submit (ResetCashOutBills machine)) ] [ text "Update Counts" ]
]
else
td [] []
actions =
[ td []
[ button [ class [ C.TableButton ], onClick (Submit (UnpairMachine machine)) ] [ text "Unpair" ] ]
, td []
[ button [ class [ C.TableButton ], onClick (Submit (RebootMachine machine)) ] [ text "Reboot OS" ] ]
, td []
[ button [ class [ C.TableButton ], onClick (Submit (RestartServices machine)) ] [ text "Restart Services" ] ]
, resetBills
]
cassetteCounts =
if machine.cashOut then
[ td []
[ div [ classList [ ( C.Component, True ), ( C.FocusedComponent, False ) ] ]
[ inputCassetteView machine Top machine.cassette1 ]
]
, td []
[ div [ classList [ ( C.Component, True ), ( C.FocusedComponent, False ) ] ]
[ inputCassetteView machine Bottom machine.cassette2 ]
]
]
else
[ td [ class [ C.CellDisabled ] ] [], td [ class [ C.CellDisabled ] ] [] ]
in
tr []
([ td [] [ text machine.name ] ]
++ cassetteCounts
++ actions
)
tableView : Machines -> Html Msg
tableView machines =
if List.isEmpty machines then
div [ class [ C.EmptyTable ] ] [ text "No paired machines." ]
else
table [ class [ C.ConfigTable ] ]
[ thead []
[ tr []
[ td [] []
, td [] [ text "Top Bill Count" ]
, td [] [ text "Bottom Bill Count" ]
]
]
, tbody [] (List.map rowView machines)
]
view : Model -> Html Msg
view model =
case model of
NotAsked ->
div [] []
Loading ->
div [] [ text "Loading..." ]
Failure err ->
div [] [ text (toString err) ]
Success subModel ->
let
statusString =
case subModel.status of
Saved ->
"Saved"
_ ->
""
in
div []
[ div [ class [ C.SectionLabel ] ]
[ div []
[ div [ class [ C.ConfigContainer ] ]
[ tableView subModel.machines
, div [ class [ C.Saving ] ] [ text statusString ]
]
]
]
]

270
lamassu-admin-elm/src/NavBar.elm
View file

@ -1,270 +0,0 @@
module NavBar exposing (view, routeToUrl)
import Html exposing (Html, Attribute, a, div, hr, input, span, text, ul, li, nav)
import Html.Events exposing (onClick)
import Html.CssHelpers
import Css.Classes
import String
import CoreTypes
exposing
( Msg(..)
, Category(..)
, Route(..)
)
{ id, class, classList } =
Html.CssHelpers.withNamespace "lamassuAdmin"
maybeUrl : String -> List (Maybe String) -> String
maybeUrl root maybeStrings =
List.filterMap identity maybeStrings
|> List.append [ root ]
|> String.join "/"
routeToUrl : Route -> String
routeToUrl route =
case route of
PairRoute ->
"/#pair"
AccountRoute account ->
"/#account/" ++ account
ConfigRoute configGroup maybeCrypto ->
maybeUrl ("/#config/" ++ configGroup) [ maybeCrypto ]
MaintenanceMachinesRoute ->
"/#machines/"
MaintenanceFundingRoute maybeCrypto ->
maybeUrl ("/#funding") [ maybeCrypto ]
TransactionsRoute ->
"/#transactions/"
TransactionRoute txId ->
"/#transaction/" ++ txId
CustomersRoute ->
"/#customers/"
CustomerRoute id ->
"/#customer/" ++ id
LogsRoute maybeId ->
"/#logs/" ++ (Maybe.withDefault "" maybeId)
SupportLogsRoute maybeId ->
"/#support_logs/" ++ (Maybe.withDefault "" maybeId)
NotFoundRoute ->
Debug.crash "Need unknown route"
linkClasses : Route -> Route -> Bool -> Attribute msg
linkClasses linkRoute route isValid =
let
validityClass =
if isValid then
[]
else
[ Css.Classes.InvalidGroup ]
active =
case route of
ConfigRoute config _ ->
linkRoute == ConfigRoute config Nothing
MaintenanceFundingRoute _ ->
linkRoute == MaintenanceFundingRoute Nothing
LogsRoute _ ->
linkRoute == LogsRoute Nothing
_ ->
linkRoute == route
in
if (active) then
class ([ Css.Classes.NavBarRoute, Css.Classes.Active ] ++ validityClass)
else
class ([ Css.Classes.NavBarRoute ] ++ validityClass)
type alias Link =
( String, Route, Bool )
activeCategory : Maybe Category -> Category -> Bool -> Attribute msg
activeCategory maybeCurrentCategory linkedCategory isValid =
let
validityClass =
if isValid then
[]
else
[ Css.Classes.InvalidGroup ]
in
case maybeCurrentCategory of
Nothing ->
class ([ Css.Classes.NavBarCategory ] ++ validityClass)
Just currentCategory ->
if currentCategory == linkedCategory then
class ([ Css.Classes.NavBarCategory, Css.Classes.Active ] ++ validityClass)
else
class ([ Css.Classes.NavBarCategory ] ++ validityClass)
categoryView : Maybe Category -> ( String, Category, Route, Bool ) -> Html Msg
categoryView currentCategory link =
let
( desc, category, linkRoute, isValid ) =
link
in
div
[ onClick (NewUrl (routeToUrl linkRoute))
, activeCategory currentCategory category isValid
]
[ text desc ]
linkView : Maybe Category -> Route -> Maybe Category -> Link -> Html Msg
linkView maybeCategory currentRoute maybeLinkedCategory link =
let
( desc, linkRoute, isValid ) =
link
in
div [ onClick (NewUrl (routeToUrl linkRoute)), linkClasses linkRoute currentRoute isValid ] [ text desc ]
linksView : Maybe Category -> Route -> ( String, Category, Route, Bool ) -> List Link -> Html Msg
linksView maybeCurrentCategory currentRoute ( catDesc, cat, route, isValid ) links =
if maybeCurrentCategory == (Just cat) then
div [ class [ Css.Classes.NavBarCategoryContainer ] ]
[ categoryView maybeCurrentCategory ( catDesc, cat, route, isValid )
, div [] (List.map (linkView maybeCurrentCategory currentRoute (Just cat)) links)
]
else
div [ class [ Css.Classes.NavBarCategoryContainer ] ]
[ categoryView maybeCurrentCategory ( catDesc, cat, route, isValid )
]
determineConfigCategory : String -> Maybe Category
determineConfigCategory configCode =
if List.member configCode [ "definition", "setup", "cashOut", "commissions", "balanceAlerts" ] then
Just MachineSettingsCat
else if List.member configCode [ "walletSettings", "notifications", "compliance", "coinAtmRadar", "terms", "operatorInfo", "fudgeFactor" ] then
Just GlobalSettingsCat
else
Nothing
allClear : List String -> Category -> Bool
allClear invalidGroups cat =
not <| List.any (\groupCode -> determineConfigCategory groupCode == Just cat) invalidGroups
determineCategory : Route -> Maybe Category
determineCategory route =
case route of
AccountRoute account ->
Just AccountCat
ConfigRoute config _ ->
determineConfigCategory config
MaintenanceMachinesRoute ->
Just MaintenanceCat
MaintenanceFundingRoute _ ->
Just MaintenanceCat
PairRoute ->
Nothing
TransactionsRoute ->
Nothing
TransactionRoute _ ->
Nothing
CustomersRoute ->
Just MaintenanceCat
CustomerRoute _ ->
Just MaintenanceCat
LogsRoute _ ->
Just MaintenanceCat
SupportLogsRoute _ ->
Nothing
NotFoundRoute ->
Nothing
view : Route -> List String -> Html Msg
view route invalidGroups =
let
maybeCategory =
determineCategory route
l =
linkView maybeCategory route Nothing
ll =
linksView maybeCategory route
isValid group =
not (List.member group invalidGroups)
allClearMachine =
allClear invalidGroups MachineSettingsCat
allClearGlobal =
allClear invalidGroups GlobalSettingsCat
configLink code display =
( display, ConfigRoute code Nothing, isValid code )
in
nav [ class [ Css.Classes.NavBar ] ]
[ l ( "Transactions", TransactionsRoute, True )
, ll ( "Maintenance", MaintenanceCat, MaintenanceMachinesRoute, True )
[ ( "Machines", MaintenanceMachinesRoute, True )
, ( "Funding", MaintenanceFundingRoute Nothing, True )
, ( "Customers", CustomersRoute, True )
, ( "Logs", LogsRoute Nothing, True )
]
, ll ( "Machine Settings", MachineSettingsCat, ConfigRoute "definition" Nothing, allClearMachine )
[ configLink "definition" "Definition"
, configLink "setup" "Setup"
, configLink "cashOut" "Cash Out"
, configLink "commissions" "Commissions"
, configLink "balanceAlerts" "Balance Alerts"
]
, ll ( "Global Settings", GlobalSettingsCat, ConfigRoute "walletSettings" Nothing, allClearGlobal )
[ configLink "walletSettings" "Wallet Settings"
, configLink "notifications" "Notifications"
, configLink "compliance" "Compliance"
, configLink "coinAtmRadar" "Coin ATM Radar"
, configLink "terms" "Terms and Conditions"
, configLink "operatorInfo" "Operator Info"
, configLink "fudgeFactor" "Fudge Factor"
]
, ll ( "Third Party Services", AccountCat, AccountRoute "bitgo", True )
[ ( "BitGo", AccountRoute "bitgo", True )
, ( "Bitstamp", AccountRoute "bitstamp", True )
, ( "Blockcypher", AccountRoute "blockcypher", True )
, ( "Infura", AccountRoute "infura", True )
, ( "itBit", AccountRoute "itbit", True )
, ( "Kraken", AccountRoute "kraken", True )
, ( "Mailgun", AccountRoute "mailgun", True )
, ( "Strike", AccountRoute "strike", True )
, ( "Twilio", AccountRoute "twilio", True )
]
, l ( "+ Add Machine", PairRoute, True )
]

132
lamassu-admin-elm/src/Pair.elm
View file

@ -1,132 +0,0 @@
module Pair exposing (..)
import Html exposing (Html, Attribute, h1, a, div, hr, input, span, text, node, button, strong, label)
import Html.Attributes exposing (id, attribute, placeholder, disabled, style, size)
import Html.Events exposing (onClick, onInput)
import Http
import HttpBuilder exposing (..)
import String
import RemoteData exposing (RemoteData(NotAsked, Loading, Failure, Success))
import QRCode
import Css.Admin exposing (..)
import Css.Classes as C
import QRCode.ECLevel as ECLevel
-- MODEL
type alias Model =
{ totem : RemoteData.WebData String
, name : String
, serverStatus : Bool
}
getTotem : String -> Cmd Msg
getTotem name =
get "/api/totem"
|> withQueryParams [ ( "name", name ) ]
|> withExpect Http.expectString
|> send RemoteData.fromResult
|> Cmd.map Load
init : Bool -> Model
init serverStatus =
{ totem = RemoteData.NotAsked
, name = ""
, serverStatus = serverStatus
}
-- UPDATE
type Msg
= Load (RemoteData.WebData String)
| InputName String
| SubmitName
updateStatus : Bool -> Model -> Model
updateStatus isUp model =
{ model | serverStatus = isUp }
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
Load webData ->
let
_ =
Debug.log "TOTEM" (RemoteData.withDefault "Network Error" webData)
in
{ model | totem = webData } ! []
InputName name ->
{ model | name = name } ! []
SubmitName ->
model ! [ getTotem model.name ]
qrCode : String -> Html msg
qrCode s =
let
resultQRCode =
QRCode.toSvgWithECLevel s ECLevel.L
in
case resultQRCode of
Result.Ok view ->
view
Result.Err err ->
Html.text (toString err)
view : Model -> Html Msg
view model =
if model.serverStatus then
case model.totem of
NotAsked ->
div []
[ h1 [] [ text "Pair a new Lamassu cryptomat" ]
, div []
[ label []
[ text "Cryptomat name"
, input
[ onInput InputName
, placeholder "Coffee shop, 43 Elm St."
, size 50
, style [ ( "margin-left", "1em" ) ]
]
[]
, button
[ onClick SubmitName, disabled (String.isEmpty model.name) ]
[ text "Pair" ]
]
]
]
Loading ->
div []
[ div [] [ text "..." ] ]
Failure err ->
div [] [ text (toString err) ]
Success totem ->
div
[]
[ div
[ class [ C.QrCode ] ]
[ qrCode totem ]
, div []
[ span [] [ text "Scan this QR Code to pair " ]
, strong [] [ text model.name ]
]
]
else
div [] [ text "Make sure lamassu-server is up before pairing" ]

552
lamassu-admin-elm/src/Selectize.elm
View file

@ -1,552 +0,0 @@
module Selectize
exposing
( initialSelectize
, view
, State
, Config
, HtmlOptions
, HtmlClasses
)
import Html exposing (..)
import Html.Attributes exposing (value, defaultValue, maxlength, class, classList, id, disabled)
import Html.Events as E exposing (on, onWithOptions)
import String
import Json.Decode as Json
import Css.Classes exposing (CssClasses)
import Css.Admin exposing (className)
-- MODEL
type alias HtmlOptions =
{ instructionsForBlank : String
, noMatches : String
, typeForMore : String
, atMaxLength : String
, noOptions : String
, notAvailable : String
, classes : HtmlClasses
, customCssClass : CssClasses
}
type alias HtmlClasses =
{ container : String
, noOptions : String
, singleItemContainer : String
, multiItemContainer : String
, selectBox : String
, selectedItems : String
, fallbackItems : String
, fallbackItem : String
, selectedItem : String
, boxContainer : String
, boxItems : String
, boxItem : String
, boxItemActive : String
, info : String
, infoNoMatches : String
, inputEditing : String
}
type alias H =
HtmlOptions
type Status
= Initial
| Editing
| Cleared
| Idle
| Blurred
type alias State =
{ boxPosition : Int
, status : Status
, string : String
}
type alias Config msg idType itemType =
{ maxItems : Int
, boxLength : Int
, toMsg : State -> msg
, onAdd : idType -> State -> msg
, onRemove : State -> msg
, onFocus : State -> msg
, onBlur : State -> msg
, toId : itemType -> idType
, enabled : Bool
, selectedDisplay : itemType -> String
, optionDisplay : itemType -> String
, match : String -> List itemType -> List itemType
, htmlOptions : HtmlOptions
}
type alias Items itemType =
{ selectedItems : List itemType
, availableItems : List itemType
, boxItems : List itemType
}
initialSelectize : State
initialSelectize =
{ boxPosition = -1, string = "", status = Blurred }
-- UPDATE
clean : String -> String
clean s =
String.trim s
|> String.toLower
updateKeyUp : Config msg idType itemType -> Items itemType -> State -> Int -> msg
updateKeyUp config items state keyCode =
if keyCode == 13 || keyCode == 9 then
config.toMsg { state | status = Initial }
else
config.toMsg state
addSelection : Config msg idType itemType -> Items itemType -> State -> msg
addSelection config items state =
let
maybeItem =
if state.boxPosition < 0 then
Nothing
else
(List.head << (List.drop state.boxPosition)) items.boxItems
in
case maybeItem of
Nothing ->
config.toMsg state
Just item ->
config.onAdd (config.toId item) { state | status = Cleared, string = "", boxPosition = -1 }
updateKeyDown : Config msg idType itemType -> Items itemType -> State -> Int -> msg
updateKeyDown config items state keyCode =
if config.maxItems > 1 && List.length items.selectedItems == config.maxItems then
case keyCode of
-- backspace
8 ->
if String.isEmpty state.string && (not << List.isEmpty) items.selectedItems then
config.onRemove state
else
config.toMsg state
_ ->
config.toMsg state
else
case keyCode of
-- up
38 ->
config.toMsg { state | boxPosition = (max -1 (state.boxPosition - 1)) }
-- down
40 ->
config.toMsg
{ state
| boxPosition =
(min ((List.length items.boxItems) - 1)
(state.boxPosition + 1)
)
}
-- enter
13 ->
addSelection config items state
-- backspace
8 ->
if String.isEmpty state.string && (not << List.isEmpty) items.selectedItems then
config.onRemove state
else
config.toMsg state
-- tab
9 ->
addSelection config items state
_ ->
config.toMsg state
-- VIEW
itemView : Config msg idType itemType -> Bool -> itemType -> Html msg
itemView config isFallback item =
let
c =
config.htmlOptions.classes
in
span
[ classList
[ ( c.selectedItem, True )
, ( c.fallbackItem, isFallback )
]
]
[ text (config.selectedDisplay item) ]
fallbackItemsView : Config msg idType itemType -> Items itemType -> List itemType -> State -> Html msg
fallbackItemsView config items fallbackItems state =
let
c =
config.htmlOptions.classes
selectedItems =
items.selectedItems
isFallback =
List.length selectedItems == 0
classes =
classList
[ ( c.selectedItems, True )
, ( c.fallbackItems, isFallback )
]
itemsView =
if isFallback then
fallbackItems
else
items.selectedItems
in
span [ classes ] (List.map (itemView config isFallback) itemsView)
itemsView : Config msg idType itemType -> Items itemType -> List itemType -> State -> Html msg
itemsView config items fallbackItems state =
case state.status of
Editing ->
fallbackItemsView config items [] state
Initial ->
fallbackItemsView config items [] state
Idle ->
fallbackItemsView config items [] state
Cleared ->
fallbackItemsView config items fallbackItems state
Blurred ->
fallbackItemsView config items fallbackItems state
editingBoxView : Config msg idType itemType -> Items itemType -> State -> Html msg
editingBoxView config items state =
let
h =
config.htmlOptions
c =
h.classes
boxItemHtml pos item =
div
[ classList
[ ( c.boxItem, True )
, ( c.boxItemActive, state.boxPosition == pos )
]
, onMouseDown config state (config.toId item)
]
[ text (config.optionDisplay item)
]
in
div [ class c.boxItems ] (List.indexedMap boxItemHtml items.boxItems)
idleBoxView : Config msg idType itemType -> Items itemType -> State -> Html msg
idleBoxView config items state =
let
h =
config.htmlOptions
numSelected =
List.length items.selectedItems
remainingItems =
List.length items.availableItems - numSelected
typeForMore =
if remainingItems > config.boxLength then
if numSelected < config.maxItems then
div [ class h.classes.info ] [ text h.typeForMore ]
else
div [ class h.classes.info ] [ text "Backspace for more" ]
else
span [] []
in
if config.maxItems > 1 && List.length items.selectedItems == config.maxItems then
span [] []
else
div [ class h.classes.boxContainer ]
[ editingBoxView config items state
, typeForMore
]
noMatches : Config msg idType itemType -> List itemType -> State -> Html msg
noMatches config boxItems state =
let
h =
config.htmlOptions
in
if List.length boxItems == 0 then
div
[ classList
[ ( h.classes.info, True )
, ( h.classes.infoNoMatches, True )
]
]
[ text h.noMatches ]
else
span [] []
boxView : Config msg idType itemType -> Items itemType -> State -> Html msg
boxView config items state =
let
h =
config.htmlOptions
in
case state.status of
Editing ->
div [ class h.classes.boxContainer ]
[ editingBoxView config items state
, noMatches config items.boxItems state
]
Initial ->
idleBoxView config items state
Idle ->
idleBoxView config items state
Cleared ->
idleBoxView config items state
Blurred ->
span [] []
buildItems : List itemType -> List itemType -> List itemType -> Items itemType
buildItems selectedItems availableItems boxItems =
{ selectedItems = selectedItems
, availableItems = availableItems
, boxItems = boxItems
}
diffItems : Config msg idType itemType -> List itemType -> List itemType -> List itemType
diffItems config a b =
let
isEqual itemA itemB =
config.toId itemA == config.toId itemB
notInB b item =
(List.any (isEqual item) b)
|> not
in
List.filter (notInB b) a
mapToItem : (itemType -> idType) -> List itemType -> idType -> Maybe itemType
mapToItem toId available id =
List.filter (((==) id) << toId) available
|> List.head
view : Config msg idType itemType -> List idType -> List itemType -> List idType -> State -> Html msg
view config selectedIds availableItems fallbackIds state =
if List.length availableItems == 0 then
div [ class config.htmlOptions.classes.container ]
[ div [ class config.htmlOptions.classes.noOptions ] [ text config.htmlOptions.noOptions ] ]
else if not config.enabled then
div [ class config.htmlOptions.classes.container ]
[ div [ class config.htmlOptions.classes.noOptions ] [ text "\x2008" ] ]
else
let
h =
config.htmlOptions
selectedItems =
List.filterMap (mapToItem config.toId availableItems) selectedIds
fallbackItems =
List.filterMap (mapToItem config.toId availableItems) fallbackIds
remainingItems =
diffItems config availableItems selectedItems
boxItems =
config.match state.string remainingItems
|> List.take 5
items =
buildItems selectedItems availableItems boxItems
onInputAtt =
onInput config state
onBlurAtt =
onBlur config state
onFocusAtt =
onFocus config state
keyDown =
if config.maxItems > 1 then
if String.isEmpty state.string then
onKeyDownNoDelete config items state
else
onKeyDownDelete config items state
else
onKeyDown config items state
editInput =
case state.status of
Initial ->
if (List.length selectedItems) < config.maxItems then
input [ onBlurAtt, onInputAtt ] []
else
input [ onBlurAtt, onInputAtt, maxlength 0 ] []
Idle ->
if (List.length selectedItems) < config.maxItems then
input [ onBlurAtt, onInputAtt ] []
else
input [ onBlurAtt, onInputAtt, maxlength 0 ] []
Editing ->
let
actualMaxlength =
if List.length boxItems == 0 then
0
else
524288
in
input [ maxlength actualMaxlength, onBlurAtt, onInputAtt, class h.classes.inputEditing ] []
Cleared ->
input [ onKeyUp config items state, value "", onBlurAtt, onInputAtt ] []
Blurred ->
input [ maxlength 0, onFocusAtt, value "" ] []
in
div [ class h.classes.container ]
[ label
[ classList
[ ( h.classes.singleItemContainer, config.maxItems == 1 )
, ( h.classes.multiItemContainer, config.maxItems > 1 )
, ( className config.htmlOptions.customCssClass, True)
]
]
[ span [ class h.classes.selectBox, keyDown ]
[ span [] [ itemsView config items fallbackItems state ]
, editInput
]
, boxView config items state
]
]
onInput : Config msg idType itemType -> State -> Attribute msg
onInput config state =
let
tagger s =
if (String.length s == 0) then
config.toMsg { state | status = Idle, string = s }
else
config.toMsg { state | status = Editing, string = s }
in
E.onInput tagger
onMouseDown : Config msg idType itemType -> State -> idType -> Attribute msg
onMouseDown config state id =
E.onMouseDown (config.onAdd id state)
onBlur : Config msg idType itemType -> State -> Attribute msg
onBlur config state =
E.onBlur (config.onBlur { state | status = Blurred })
onFocus : Config msg idType itemType -> State -> Attribute msg
onFocus config state =
E.onFocus (config.onFocus { state | status = Initial, boxPosition = -1 })
onKeyDownDelete : Config msg idType itemType -> Items itemType -> State -> Attribute msg
onKeyDownDelete config items state =
rawOnKeyDown deleteSpecialKeys (updateKeyDown config items state)
onKeyDownNoDelete : Config msg idType itemType -> Items itemType -> State -> Attribute msg
onKeyDownNoDelete config items state =
rawOnKeyDown noDeleteSpecialKeys (updateKeyDown config items state)
onKeyDown : Config msg idType itemType -> Items itemType -> State -> Attribute msg
onKeyDown config items state =
rawOnKeyDownNoPrevent (updateKeyDown config items state)
onKeyUp : Config msg idType itemType -> Items itemType -> State -> Attribute msg
onKeyUp config items state =
rawOnKeyUp (updateKeyUp config items state)
noDeleteSpecialKeys : List Int
noDeleteSpecialKeys =
[ 8, 38, 40, 9, 13, 27 ]
deleteSpecialKeys : List Int
deleteSpecialKeys =
[ 38, 40, 9, 13, 27 ]
preventSpecialDecoder : List Int -> Json.Decoder Int
preventSpecialDecoder specialKeys =
E.keyCode
|> Json.andThen
(\code ->
if List.member code specialKeys then
Json.succeed code
else
Json.fail "don't prevent"
)
rawOnKeyDown : List Int -> (Int -> msg) -> Attribute msg
rawOnKeyDown specialKeys tagger =
let
options =
{ stopPropagation = False, preventDefault = True }
in
onWithOptions "keydown" options (Json.map tagger (preventSpecialDecoder specialKeys))
rawOnKeyDownNoPrevent : (Int -> msg) -> Attribute msg
rawOnKeyDownNoPrevent tagger =
onWithOptions "keydown" { stopPropagation = False, preventDefault = False } (Json.map tagger E.keyCode)
rawOnKeyUp : (Int -> msg) -> Attribute msg
rawOnKeyUp tagger =
on "keyup" (Json.map tagger E.keyCode)

55
lamassu-admin-elm/src/SelectizeHelper.elm
View file

@ -1,55 +0,0 @@
module SelectizeHelper exposing (LocalConfig, buildConfig)
import Selectize exposing (..)
import Css.Selectize
import Css.Classes exposing (CssClasses)
type alias LocalConfig msg idType itemType =
{ toMsg : State -> msg
, onAdd : idType -> State -> msg
, onRemove : State -> msg
, onFocus : State -> msg
, onBlur : State -> msg
, toId : itemType -> idType
, enabled : Bool
}
type alias SpecificConfig itemType =
{ selectedDisplay : itemType -> String
, optionDisplay : itemType -> String
, maxItems : Int
, match : String -> List itemType -> List itemType
, customCssClass: CssClasses
}
buildConfig :
LocalConfig msg idType itemType
-> SpecificConfig itemType
-> Config msg idType itemType
buildConfig localConfig specificConfig =
{ maxItems = specificConfig.maxItems
, boxLength = 5
, toMsg = localConfig.toMsg
, onAdd = localConfig.onAdd
, onRemove = localConfig.onRemove
, onFocus = localConfig.onFocus
, onBlur = localConfig.onBlur
, toId = localConfig.toId
, enabled = localConfig.enabled
, selectedDisplay = specificConfig.selectedDisplay
, optionDisplay = specificConfig.optionDisplay
, match = specificConfig.match
, htmlOptions =
{ instructionsForBlank = "Start typing for options"
, noMatches = "No matches"
, atMaxLength = "Type backspace to edit"
, typeForMore = "Type for more options"
, noOptions = "No options"
, notAvailable = "N/A"
, classes = Css.Selectize.classes
, customCssClass = specificConfig.customCssClass
}
}

29
lamassu-admin-elm/src/StatusDecoder.elm
View file

@ -1,29 +0,0 @@
module StatusDecoder exposing (..)
import StatusTypes exposing (..)
import Json.Decode exposing (..)
rateDecoder : Decoder Rate
rateDecoder =
map3 Rate
(field "crypto" string)
(field "bid" float)
(field "ask" float)
serverDecoder : Decoder ServerRec
serverDecoder =
map5 ServerRec
(field "up" bool)
(field "lastPing" (nullable string))
(field "rates" (list rateDecoder))
(field "machineStatus" string)
(field "wasConfigured" bool)
statusDecoder : Decoder StatusRec
statusDecoder =
map2 StatusRec
(field "server" serverDecoder)
(field "invalidConfigGroups" (list string))

29
lamassu-admin-elm/src/StatusTypes.elm
View file

@ -1,29 +0,0 @@
module StatusTypes exposing (..)
import RemoteData exposing (..)
type alias Rate =
{ crypto : String
, bid : Float
, ask : Float
}
type alias ServerRec =
{ up : Bool
, lastPing : Maybe String
, rates : List Rate
, machineStatus : String
, wasConfigured : Bool
}
type alias StatusRec =
{ server : ServerRec
, invalidConfigGroups : List String
}
type alias WebStatus =
WebData StatusRec

18
lamassu-admin-elm/src/Stylesheets.elm
View file

@ -1,18 +0,0 @@
port module Stylesheets exposing (..)
import Css.File exposing (CssFileStructure, CssCompilerProgram)
import Css.Main
port files : CssFileStructure -> Cmd msg
fileStructure : CssFileStructure
fileStructure =
Css.File.toFileStructure
[ ( "../public/styles.css", Css.File.compile [ Css.Main.css ] ) ]
main : CssCompilerProgram
main =
Css.File.compiler files fileStructure

20
lamassu-admin-elm/src/SupportLogs/Rest.elm
View file

@ -1,20 +0,0 @@
module SupportLogs.Rest exposing (..)
import RemoteData exposing (..)
import Http
import Common.Logs.Decoder exposing (logsDecoder, supportLogDecoder, supportLogsDecoder)
import SupportLogs.Types exposing (..)
getAllLogs : Maybe String -> Cmd Msg
getAllLogs maybeId =
Http.get ("/api/support_logs/logs?supportLogId=" ++ (Maybe.withDefault "" maybeId)) logsDecoder
|> RemoteData.sendRequest
|> Cmd.map LoadLogs
getSupportLogs : Cmd Msg
getSupportLogs =
Http.get "/api/support_logs/" supportLogsDecoder
|> RemoteData.sendRequest
|> Cmd.map LoadSupportLogs

34
lamassu-admin-elm/src/SupportLogs/State.elm
View file

@ -1,34 +0,0 @@
module SupportLogs.State exposing (..)
import RemoteData exposing (..)
import SupportLogs.Rest exposing (..)
import SupportLogs.Types exposing (..)
init : Model
init =
{ logs = NotAsked, supportLogs = NotAsked }
load : Maybe String -> ( Model, Cmd Msg )
load maybeId =
( { logs = Loading, supportLogs = Loading }, getSupportData maybeId )
getSupportData : Maybe String -> Cmd Msg
getSupportData maybeId =
Cmd.batch [ getAllLogs maybeId, getSupportLogs ]
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
LoadLogs response ->
( { model | logs = response }
, Cmd.none
)
LoadSupportLogs response ->
( { model | supportLogs = response }
, Cmd.none
)

15
lamassu-admin-elm/src/SupportLogs/Types.elm
View file

@ -1,15 +0,0 @@
module SupportLogs.Types exposing (..)
import RemoteData exposing (..)
import Common.Logs.Types exposing (..)
type alias Model =
{ logs : WebData Logs
, supportLogs : WebData SupportLogs
}
type Msg
= LoadLogs (WebData Logs)
| LoadSupportLogs (WebData SupportLogs)

123
lamassu-admin-elm/src/SupportLogs/View.elm
View file

@ -1,123 +0,0 @@
module SupportLogs.View exposing (..)
import Html exposing (..)
import Html.Attributes exposing (href)
import Css.Admin exposing (..)
import Css.Classes as C
import RemoteData exposing (..)
import List
import Common.Logs.Types exposing (..)
import SupportLogs.Types exposing (..)
import Date exposing (..)
import Date.Extra exposing (toFormattedString)
supportLogText : SupportLog -> Html Msg
supportLogText supportLog =
text (supportLog.name ++ " " ++ (toFormattedString "yyyy-MM-dd HH:mm" supportLog.timestamp))
supportLogLink : SupportLog -> Html Msg
supportLogLink supportLog =
a [ href ("/#support_logs/" ++ supportLog.id) ] [ supportLogText supportLog ]
formatDate : Date -> String
formatDate date =
toFormattedString "yyyy-MM-dd HH:mm" date
rowView : Log -> Html Msg
rowView log =
tr [ class [] ]
[ td [] [ text (formatDate log.timestamp) ]
, td [] [ text log.logLevel ]
, td [] [ text log.message ]
]
supportLogItemView : SupportLog -> Html Msg
supportLogItemView supportLog =
li [] [ supportLogLink supportLog ]
supportLogsView : SupportLogs -> Html Msg
supportLogsView supportLogs =
if List.isEmpty supportLogs then
div [ class [ C.EmptyTable ] ] [ text "No shared logs" ]
else
div []
[ div [ class [ C.TxTable ] ]
[ ul [] (List.map supportLogItemView supportLogs)
]
]
supportLogs : Model -> Html Msg
supportLogs model =
case model.supportLogs of
NotAsked ->
div [] []
Loading ->
div [] [ text "Loading snapshots ..." ]
Failure err ->
div [] [ text (toString err) ]
Success supportLogs ->
div [] [ supportLogsView supportLogs ]
logsView : Logs -> Html Msg
logsView logs =
if List.isEmpty logs.logs then
div [] [ text "No logs yet." ]
else
div []
[ table [ class [ C.TxTable ] ]
[ thead []
[ tr []
[ td [] [ text "Date" ]
, td [] [ text "Level" ]
, td [] [ text "Message" ]
]
]
, tbody [] (List.map rowView logs.logs)
]
]
logs : Model -> Html Msg
logs model =
case model.logs of
NotAsked ->
div [] []
Loading ->
div [] [ text "Loading logs..." ]
Failure err ->
div [] [ text "No logs yet." ]
Success logs ->
div []
[ logsView logs
]
view : Model -> Html Msg
view model =
div []
[ h1 [] [ text "Lamassu support logs" ]
, div [ class [ C.PaneWrapper ] ]
[ div [ class [ C.LeftPane ] ]
[ h2 [] [ text "Shared snapshots" ]
, supportLogs model
]
, div [ class [ C.ContentPane ] ]
[ h2 [] [ text "Logs" ]
, logs model
]
]
]

107
lamassu-admin-elm/src/Transaction/Decoder.elm
View file

@ -1,107 +0,0 @@
module Transaction.Decoder exposing (..)
import Json.Decode exposing (..)
import Json.Decode.Extra exposing (date, fromResult)
import Json.Decode.Pipeline exposing (decode, required, optional, hardcoded)
import Common.TransactionTypes exposing (..)
import String
mapCryptoCode : String -> Decoder CryptoCode
mapCryptoCode code =
case code of
"BTC" -> succeed BTC
"BCH" -> succeed BCH
"ETH" -> succeed ETH
"ZEC" -> succeed ZEC
"DASH" -> succeed DASH
"LTC" -> succeed LTC
_ -> fail ("No such cryptocurrency: " ++ code)
cryptoCodeDecoder : Decoder CryptoCode
cryptoCodeDecoder =
string
|> andThen mapCryptoCode
txDecode : String -> Decoder Tx
txDecode txClass =
case txClass of
"cashIn" ->
map CashInTx cashInTxDecoder
"cashOut" ->
map CashOutTx cashOutTxDecoder
_ ->
fail ("Unknown tx class: " ++ txClass)
txsDecoder : Decoder (List Tx)
txsDecoder =
(field "transactions" (list txDecoder))
txDecoder : Decoder Tx
txDecoder =
(field "txClass" string)
|> andThen txDecode
floatString : Decoder Float
floatString =
string |> andThen (String.toFloat >> fromResult)
intString : Decoder Int
intString =
string |> andThen (String.toInt >> fromResult)
cashInTxDecoder : Decoder CashInTxRec
cashInTxDecoder =
decode CashInTxRec
|> required "id" string
|> required "machineName" string
|> required "toAddress" string
|> required "cryptoAtoms" intString
|> required "cryptoCode" cryptoCodeDecoder
|> required "fiat" floatString
|> required "commissionPercentage" (nullable floatString)
|> required "rawTickerPrice" (nullable floatString)
|> required "fiatCode" string
|> required "txHash" (nullable string)
|> required "phone" (nullable string)
|> required "error" (nullable string)
|> required "operatorCompleted" bool
|> required "send" bool
|> required "sendConfirmed" bool
|> required "expired" bool
|> required "created" date
confirmedDecoder : Decoder Bool
confirmedDecoder =
map (Maybe.map (always True) >> Maybe.withDefault False)
(nullable string)
cashOutTxDecoder : Decoder CashOutTxRec
cashOutTxDecoder =
decode CashOutTxRec
|> required "id" string
|> required "machineName" string
|> required "toAddress" string
|> required "cryptoAtoms" intString
|> required "cryptoCode" cryptoCodeDecoder
|> required "fiat" floatString
|> required "commissionPercentage" (nullable floatString)
|> required "rawTickerPrice" (nullable floatString)
|> required "fiatCode" string
|> required "status" string
|> required "dispense" bool
|> required "notified" bool
|> required "redeem" bool
|> required "phone" (nullable string)
|> required "error" (nullable string)
|> required "created" date
|> required "confirmedAt" confirmedDecoder
|> required "expired" bool

31
lamassu-admin-elm/src/Transaction/Rest.elm
View file

@ -1,31 +0,0 @@
module Transaction.Rest exposing (..)
import RemoteData exposing (..)
import HttpBuilder exposing (..)
import Http
import HttpBuilder exposing (..)
import BasicTypes exposing (..)
import Common.TransactionTypes exposing (..)
import Transaction.Types exposing (..)
import Transaction.Decoder exposing (txDecoder)
toModel : SavingStatus -> Tx -> SubModel
toModel status tx =
{ status = status, tx = tx }
getForm : String -> Cmd Msg
getForm txId =
get ("/api/transaction/" ++ txId)
|> withExpect (Http.expectJson txDecoder)
|> send (Result.map (toModel NotSaving) >> RemoteData.fromResult)
|> Cmd.map Load
cancel : String -> Cmd Msg
cancel txId =
patch ("/api/transaction/" ++ txId ++ "?cancel=true")
|> withExpect (Http.expectJson txDecoder)
|> send (Result.map (toModel NotSaving) >> RemoteData.fromResult)
|> Cmd.map Load

34
lamassu-admin-elm/src/Transaction/State.elm
View file

@ -1,34 +0,0 @@
module Transaction.State exposing (..)
import RemoteData exposing (..)
import Transaction.Types exposing (..)
import Transaction.Rest exposing (..)
import BasicTypes exposing (..)
init : Model
init =
NotAsked
load : String -> ( Model, Cmd Msg )
load txId =
( Loading, getForm txId )
txUpdate : SubModel -> ( SubModel, Cmd Msg )
txUpdate model =
model ! []
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
Load newModel ->
RemoteData.update txUpdate newModel
Cancel txId ->
model ! [ cancel txId ]
HideSaveIndication ->
RemoteData.update (\subModel -> { subModel | status = NotSaving } ! []) model

21
lamassu-admin-elm/src/Transaction/Types.elm
View file

@ -1,21 +0,0 @@
module Transaction.Types exposing (..)
import RemoteData exposing (..)
import BasicTypes exposing (..)
import Common.TransactionTypes exposing (..)
type alias SubModel =
{ status : SavingStatus
, tx : Tx
}
type alias Model =
RemoteData.WebData SubModel
type Msg
= Load Model
| Cancel String
| HideSaveIndication

107
lamassu-admin-elm/src/Transaction/View.elm
View file

@ -1,107 +0,0 @@
module Transaction.View exposing (..)
import Html exposing (..)
import Html.Events exposing (onClick)
import RemoteData exposing (..)
import Common.TransactionTypes exposing (..)
import Transaction.Types exposing (..)
import Numeral exposing (format)
import Maybe.Extra exposing (isJust)
-- import Css.Admin exposing (..)
-- import Css.Classes as C
cashInTxView : CashInTxRec -> Html Msg
cashInTxView tx =
let
cancelStatus =
if tx.operatorCompleted then
"Cancelled"
else if tx.sendConfirmed then
"Sent"
else if tx.expired then
"Expired"
else
"Pending"
cancellable =
not (tx.operatorCompleted || tx.sendConfirmed || tx.expired)
cancelButtonDiv =
if cancellable then
div []
[ button [ onClick (Cancel tx.id) ] [ text "Cancel transaction" ]
]
else
div [] []
error =
Maybe.withDefault "Successful" tx.error
in
div []
[ div [] [ text tx.id ]
, div [] [ text "This is a cash-in transaction" ]
, div [] [ text ("Fiat: " ++ (format "0,0.00" tx.fiat)) ]
, div [] [ text ("Raw ticker price: " ++ (format "0,0.00" (Maybe.withDefault 0.0 tx.rawTickerPrice))) ]
, div [] [ text ("Status: " ++ cancelStatus) ]
, div [] [ text error ]
, cancelButtonDiv
]
cashOutTxView : CashOutTxRec -> Html Msg
cashOutTxView tx =
let
cancelStatus =
if isJust tx.error then
"Error"
else if tx.dispense then
"Success"
else if tx.expired then
"Expired"
else
"Pending"
error =
case tx.error of
Nothing ->
"No errors"
Just err ->
"Error: " ++ err
in
div []
[ div [] [ text tx.id ]
, div [] [ text "This is a cash-out transaction" ]
, div [] [ text ("Fiat: " ++ (format "0,0.00" tx.fiat)) ]
, div [] [ text ("Raw ticker price: " ++ (format "0,0.00" (Maybe.withDefault 0.0 tx.rawTickerPrice))) ]
, div [] [ text ("Status: " ++ cancelStatus) ]
, div [] [ text error ]
]
txView : SubModel -> Html Msg
txView subModel =
case subModel.tx of
CashInTx cashInTxRec ->
cashInTxView cashInTxRec
CashOutTx cashOutTxRec ->
cashOutTxView cashOutTxRec
view : Model -> Html Msg
view model =
case model of
NotAsked ->
div [] []
Loading ->
div [] [ text "Loading..." ]
Failure err ->
div [] [ text (toString err) ]
Success subModel ->
txView subModel

206
lamassu-admin-elm/src/Transactions.elm
View file

@ -1,206 +0,0 @@
module Transactions exposing (..)
import Html exposing (..)
import Html.Attributes exposing (colspan, href)
import Css.Admin exposing (..)
import Css.Classes as C
import RemoteData exposing (..)
import Http
import HttpBuilder exposing (..)
import Transaction.Decoder exposing (txsDecoder)
import Common.TransactionTypes exposing (..)
import List
import Numeral exposing (format)
import Date.Extra exposing (toFormattedString)
import Maybe.Extra exposing (isJust)
type alias Txs =
List Tx
type alias Model =
RemoteData.WebData Txs
init : Model
init =
NotAsked
loadCmd : Cmd Msg
loadCmd =
getTransactions
load : ( Model, Cmd Msg )
load =
( Loading, loadCmd )
getTransactions : Cmd Msg
getTransactions =
get ("/api/transactions")
|> withExpect (Http.expectJson txsDecoder)
|> send RemoteData.fromResult
|> Cmd.map Load
type Msg
= Load Model
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
Load loadedModel ->
loadedModel ! []
multiplier : CryptoCode -> Float
multiplier code =
case code of
BTC ->
1.0e8
BCH ->
1.0e8
ETH ->
1.0e18
ZEC ->
1.0e8
DASH ->
1.0e8
LTC ->
1.0e8
txLink : String -> Html Msg
txLink txId =
a [ href ("/#transaction/" ++ txId) ] [ text (String.left 8 txId) ]
cryptoCodeDisplay : CryptoCode -> Html Msg
cryptoCodeDisplay code =
let
txt : String
txt = case code of
BTC -> "BTC"
BCH -> "BCH"
ETH -> "ETH"
ZEC -> "ZEC"
DASH -> "DASH"
LTC -> "LTC"
in
text txt
rowView : Tx -> Html Msg
rowView tx =
case tx of
CashInTx cashIn ->
let
rowClasses =
if cashIn.operatorCompleted then
[ C.CashIn, C.TxCancelled ]
else
[ C.CashIn ]
status =
if cashIn.operatorCompleted then
"Cancelled"
else if isJust cashIn.error then
"Error"
else if cashIn.sendConfirmed then
"Sent"
else if cashIn.expired then
"Expired"
else
"Pending"
in
tr [ class rowClasses ]
[ td [] [ txLink cashIn.id ]
, td [] [ text status ]
, td
[ class [ C.NumberColumn ] ]
[ text (toFormattedString "yyyy-MM-dd HH:mm" cashIn.created) ]
, td [] [ text cashIn.machineName ]
, td [ class [ C.NumberColumn ] ]
[ text (format "0,0.000000" ((toFloat cashIn.cryptoAtoms) / multiplier cashIn.cryptoCode))
]
, td [] [ cryptoCodeDisplay cashIn.cryptoCode ]
, td [ class [ C.NumberColumn ] ] [ text (format "0,0.00" cashIn.fiat) ]
, td [ class [ C.NumberColumn ] ] [ text (format "0,0.00" (Maybe.withDefault 0.0 cashIn.commissionPercentage)) ]
, td [ class [ C.NumberColumn ] ] [ text (Maybe.withDefault "" cashIn.phone) ]
, td [ class [ C.TxAddress ] ] [ text cashIn.toAddress ]
]
CashOutTx cashOut ->
let
status =
if isJust cashOut.error then
"Error"
else if cashOut.dispense then
"Success"
else if cashOut.expired then
"Expired"
else
"Pending"
in
tr [ class [ C.CashOut ] ]
[ td [] [ txLink cashOut.id ]
, td [] [ text status ]
, td [ class [ C.NumberColumn, C.DateColumn ] ] [ text (toFormattedString "yyyy-MM-dd HH:mm" cashOut.created) ]
, td [] [ text cashOut.machineName ]
, td [ class [ C.NumberColumn ] ]
[ text (format "0,0.000000" ((toFloat cashOut.cryptoAtoms) / multiplier cashOut.cryptoCode))
]
, td [] [ cryptoCodeDisplay cashOut.cryptoCode ]
, td [ class [ C.NumberColumn ] ] [ text (format "0,0.00" cashOut.fiat) ]
, td [ class [ C.NumberColumn ] ] [ text (format "0,0.00" (Maybe.withDefault 0.0 cashOut.commissionPercentage)) ]
, td [ class [ C.NumberColumn ] ] [ text (Maybe.withDefault "" cashOut.phone) ]
, td [ class [ C.TxAddress ] ] [ text cashOut.toAddress ]
]
tableView : Txs -> Html Msg
tableView txs =
if List.isEmpty txs then
div [] [ text "No activity yet." ]
else
table [ class [ C.TxTable ] ]
[ thead []
[ tr []
[ td [ class [ C.TxId ] ] [ text "Id" ]
, td [] [ text "Status" ]
, td [ class [ C.TxDate ] ] [ text "Time" ]
, td [ class [ C.TxMachine ] ] [ text "Machine" ]
, td [ colspan 2 ] [ text "Crypto" ]
, td [ class [ C.TxAmount ] ] [ text "Fiat" ]
, td [ class [ C.TxAmount ] ] [ text "Commission" ]
, td [ class [ C.TxPhone ] ] [ text "Phone" ]
, td [ class [ C.TxAddress ] ] [ text "To address" ]
]
]
, tbody [] (List.map rowView txs)
]
view : Model -> Html Msg
view model =
case model of
NotAsked ->
div [] []
Loading ->
div [] [ text "Loading..." ]
Failure err ->
div [] [ text (toString err) ]
Success txs ->
div [] [ tableView txs ]

1
lamassu-admin-elm/tests/.gitignore vendored
View file

@ -1 +0,0 @@
/elm-stuff/

66
lamassu-admin-elm/tests/AccountTypesTests.elm
View file

@ -1,66 +0,0 @@
module AccountTypesTests exposing (..)
import Test exposing (..)
import Expect
import AccountTypes
import Result
import FieldSetTypes exposing (..)
import AccountDecoder
testString : String
testString =
"""
{
"code": "twilio",
"display": "Twilio",
"fieldSet": {
"fields": [
{
"code": "accountSid",
"display": "Account SID",
"type": "string",
"secret": false,
"required": true,
"value": {
"fieldType": "string",
"value": "xx123"
},
"status": { "code": "idle" }
}
]
}
}
"""
testRecord : AccountTypes.Account
testRecord =
{ code = "twilio"
, display = "Twilio"
, fieldSet =
{ fields =
[ { code = "accountSid"
, display = "Account SID"
, secret = False
, required = True
, value = FieldString "xx123"
, loadedValue = FieldString "xx123"
, status = FieldIdle
}
]
}
}
all : Test
all =
describe "Parse InitialRecord"
[ test "Basic record" <|
\() ->
let
parsed =
AccountDecoder.decodeAccount testString
in
Expect.equal parsed (Ok testRecord)
]

100
lamassu-admin-elm/tests/ConfigTypesTests.elm
View file

@ -1,100 +0,0 @@
module ConfigTypesTests exposing (..)
import Test exposing (..)
import Expect
import AccountTypes
import Result
import FieldSetTypes exposing (..)
import ConfigTypes exposing (..)
import ConfigDecoder exposing (configGroupDecoder)
import Json.Decode exposing (decodeString)
testString : String
testString =
"""
{
"code": "main",
"display": "Main",
"crypto": "global",
"cryptoConfigs": [
{
"crypto": "BTC",
"machineConfigs": [
{
"machine": "01",
"fieldSet": {
"fields": [
{
"code": "cash-in-commission",
"display": "Cash In Commission",
"secret": false,
"required": false,
"value": {
"fieldType": "percentage",
"value": 15
},
"status": {
"code": "idle"
}
}
]
}
}
]
}
],
"cryptos": [
{
"crypto": "BTC",
"display": "Bitcoin"
}
]
}
"""
testRecord : ConfigTypes.ConfigGroup
testRecord =
{ code = "main"
, display = "Main"
, crypto = GlobalCrypto
, cryptoConfigs =
[ { crypto = CryptoCode "BTC"
, machineConfigs =
[ { machine = MachineId "01"
, fieldSet =
{ fields =
[ { code = "cash-in-commission"
, display = "Cash In Commission"
, secret = False
, required = False
, value = FieldPercentage 15
, loadedValue = FieldPercentage 15
, status = FieldIdle
}
]
}
}
]
}
]
, cryptos =
[ { crypto = CryptoCode "BTC"
, display = "Bitcoin"
}
]
}
all : Test
all =
describe "Parse InitialRecord"
[ test "Basic record" <|
\() ->
let
parsed =
decodeString configGroupDecoder testString
in
Expect.equal parsed (Ok testRecord)
]

Some files were not shown because too many files have changed in this diff Show more