e21d0ba · warden · git.iko.soy

backend/Bridge.purs+22−13

@@ -39,25 +39,34 @@ derive instance genericCmd :: Generic Cmd _

3939derive instance eqCmd :: Eq Cmd

4040derive instance ordCmd :: Ord Cmd

4141

42−newtype Sub_Hello =

43− Sub_Hello {

44− first :: String

45− , second :: String

42+newtype Sub_LoadCiphers =

43+ Sub_LoadCiphers {

44+ date :: String

45+ , name :: String

4646 }

4747

48−instance encodeJsonSub_Hello :: EncodeJson Sub_Hello where

48+instance encodeJsonSub_LoadCiphers :: EncodeJson Sub_LoadCiphers where

4949 encodeJson = genericEncodeAeson Argonaut.defaultOptions

50−instance decodeJsonSub_Hello :: DecodeJson Sub_Hello where

50+instance decodeJsonSub_LoadCiphers :: DecodeJson Sub_LoadCiphers where

5151 decodeJson = genericDecodeAeson Argonaut.defaultOptions

52−derive instance genericSub_Hello :: Generic Sub_Hello _

53−derive instance eqSub_Hello :: Eq Sub_Hello

54−derive instance ordSub_Hello :: Ord Sub_Hello

52+derive instance genericSub_LoadCiphers :: Generic Sub_LoadCiphers _

53+derive instance eqSub_LoadCiphers :: Eq Sub_LoadCiphers

54+derive instance ordSub_LoadCiphers :: Ord Sub_LoadCiphers

55+

56+newtype Sub_LoadCiphers_List =

57+ Sub_LoadCiphers_List (Array Sub_LoadCiphers)

58+

59+instance encodeJsonSub_LoadCiphers_List :: EncodeJson Sub_LoadCiphers_List where

60+ encodeJson = genericEncodeAeson Argonaut.defaultOptions

61+instance decodeJsonSub_LoadCiphers_List :: DecodeJson Sub_LoadCiphers_List where

62+ decodeJson = genericDecodeAeson Argonaut.defaultOptions

63+derive instance genericSub_LoadCiphers_List :: Generic Sub_LoadCiphers_List _

64+derive instance eqSub_LoadCiphers_List :: Eq Sub_LoadCiphers_List

65+derive instance ordSub_LoadCiphers_List :: Ord Sub_LoadCiphers_List

5566

5667data Sub =

57− Empty

58− | Error String

59− | GotEverything String

60− | Hello Sub_Hello

68+ Error String

69+ | LoadCiphers Sub_LoadCiphers_List

6170 | NeedsLogin

6271

6372instance encodeJsonSub :: EncodeJson Sub where

backend/Main.purs+24−11

@@ -2,21 +2,27 @@ module Main

22 ( main

33 ) where

44

5+import Bridge

56import Prelude

7+import BW (CryptoService)

68import BW as WB

7−import BW.Logic (decrypt)

9+import BW.Logic (decrypt, liftPromise)

810import BW.Logic as Logic

9−import BW.Types (Email(..), EncryptedString(..), Password(..), Urls)

11+import BW.Types (Email(..), EncryptedString(..), Password(..), Urls, CipherResponse)

1012import Bridge as Bridge

13+import Control.El (class HasL, Al, L(..), l)

1114import Control.Monad.Reader (runReaderT)

1215import Control.Promise (Promise)

1316import Control.Promise as Promise

1417import Data.Argonaut (class EncodeJson, encodeJson)

1518import Data.Argonaut as Json

19+import Data.Array as A

1620import Data.Either (Either(..))

1721import Data.Maybe (Maybe(..))

1822import Data.Nullable (Nullable, null, toNullable)

1923import Data.Nullable as Nullable

24+import Data.SymmetricCryptoKey (SymmetricCryptoKey)

25+import Data.Timestamp as Timestamp

2026import Data.Traversable (traverse)

2127import Effect (Effect)

2228import Effect.Aff (Aff, runAff_, try)

@@ -41,7 +47,7 @@ main = do

4147 urls = baseUrl server

4248 runElmAff app do

4349 unauthedApi <- liftPromise $ services.getApi urls null

44− { masterKey, token } <-

50+ { masterKey, token, key } <-

4551 flip runReaderT { api: unauthedApi, crypto: services.crypto } do

4652 token <-

4753 try (Logic.getLogInRequestToken (Email email) (Password password))

@@ -49,21 +55,28 @@ main = do

4955 Left _ -> liftEffect $ Exc.throw "Could not log in. Please check your data and try again."

5056 Right t -> pure t

5157 masterKey <- Logic.makePreloginKey (Email email) (Password password)

52− pure { token, masterKey }

58+ key <- Logic.makeDecryptionKey masterKey token.key

59+ pure { token, masterKey, key }

5360 api <- liftPromise $ services.getApi urls (nullify token)

5461 _ <-

55− flip runReaderT { api: api, crypto: services.crypto } do

62+ flip runReaderT { api: api, crypto: services.crypto, key: key } do

5663 sync <- liftPromise $ api.getSync unit

57− key <- Logic.makeDecryptionKey masterKey sync.profile.key

58− log $ show key.keyB64

59− ciphersNames <- traverse (decrypt key) $ map _.name sync.ciphers

60− liftEffect $ Elm.send app $ Bridge.Hello $ Bridge.Sub_Hello { first: "hello", second: show ciphersNames }

64+ processedCiphers <- traverse processCipher sync.ciphers

65+ liftEffect $ Elm.send app $ LoadCiphers $ Bridge.Sub_LoadCiphers_List (A.take 3 processedCiphers)

6166 pure unit

6267 pure unit

6368 Bridge.Init -> Elm.send app (Bridge.NeedsLogin)

6469

65−liftPromise ∷ forall m a. MonadAff m ⇒ Promise a → m a

66−liftPromise = Aff.liftAff <<< Promise.toAff

70+processCipher ::

71+ forall r.

72+ HasL "crypto" CryptoService r =>

73+ HasL "key" SymmetricCryptoKey r =>

74+ CipherResponse -> Al r Bridge.Sub_LoadCiphers

75+processCipher cipher = do

76+ name <- decrypt cipher.name

77+ pure

78+ $ Bridge.Sub_LoadCiphers

79+ { name: name, date: Timestamp.toLocalDateTimeString cipher.revisionDate }

6780

6881runElmAff :: FFI.Elm -> Aff Unit -> Effect Unit

6982runElmAff app =

bridge.yaml+4−5

@@ -1,11 +1,10 @@

11Sub:

2−- Hello:

3− first: String

4− second: String

5−- GotEverything: String

6−- Empty

72- NeedsLogin

83- Error: String

4+- LoadCiphers:

5+ List:

6+ name: String

7+ date: String

98

109Cmd:

1110- Init

bw/spago.dhall+1

@@ -6,6 +6,7 @@

66 , "argonaut-generic"

77 , "arraybuffer-types"

88 , "console"

9+ , "datetime-parsing"

910 , "effect"

1011 , "el"

1112 , "foreign"

bw/src/BW/Logic.purs+6−3

@@ -5,6 +5,7 @@ import BW.Types

55import Control.El

66import Prelude

77import Control.Monad.Error.Class (throwError)

8+import Control.Promise (Promise)

89import Control.Promise as Promise

910import Data.EncString as EncString

1011import Data.Function.Uncurried (runFn2, runFn3, runFn4)

@@ -13,7 +14,7 @@ import Data.Nullable (null, toNullable)

1314import Data.String as String

1415import Data.SymmetricCryptoKey (SymmetricCryptoKey)

1516import Data.SymmetricCryptoKey as SymmetricCryptoKey

16−import Effect.Aff.Class (liftAff)

17+import Effect.Aff.Class (class MonadAff, liftAff)

1718import Effect.Class (liftEffect)

1819import Effect.Class.Console (log)

1920import Effect.Exception (error)

@@ -87,11 +88,13 @@ getLogInRequestToken email password = do

8788decrypt ::

8889 forall r.

8990 HasL "crypto" CryptoService r =>

90− SymmetricCryptoKey ->

91+ HasL "key" SymmetricCryptoKey r =>

9192 EncryptedString ->

9293 Al r String

93−decrypt key input = do

94+decrypt input = do

9495 crypto <- l (L :: L "crypto")

96+ key <- l (L :: L "key")

9597 liftPromise $ runFn2 crypto.decryptToUtf8 (EncString.fromString input) key

9698

99+liftPromise ∷ forall m a. MonadAff m ⇒ Promise a → m a

97100liftPromise = liftAff <<< Promise.toAff

bw/src/BW/Types.purs+3−1

@@ -1,10 +1,12 @@

11module BW.Types where

22

33import Prelude

4+

45import Data.ArrayBuffer.Types (ArrayBuffer)

56import Data.Date (Date)

67import Data.Nullable (Nullable)

78import Data.ShowableJson (ShowableJson)

9+import Data.Timestamp (Timestamp(..))

810import Data.Undefined.NoProblem (Opt)

911

1012newtype EncryptedString

@@ -385,7 +387,7 @@ type CipherResponse

385387 , edit :: Boolean

386388 , viewPassword :: Boolean

387389 , organizationUseTotp :: Boolean

388− , revisionDate :: String

390+ , revisionDate :: Timestamp

389391 , attachments :: Nullable (Array AttachmentResponse)

390392 , passwordHistory :: Nullable (Array PasswordHistoryResponse)

391393 , collectionIds :: Nullable (Array String)

bw/src/Data/EncString.purs+1−1

@@ -1,7 +1,7 @@

11module Data.EncString where

22

33import Prelude

4−import BW.Types (EncryptedString(..))

4+import BW.Types (EncryptedString)

55

66foreign import data EncString :: Type

77

bw/src/Data/Timestamp.jsnew file+4

@@ -0,0 +1,4 @@

1+export function toLocalDateTimeString(str) {

2+ const x = new Date(str);

3+ return x.toLocaleDateString() + " " + x.toLocaleTimeString();

4+}

bw/src/Data/Timestamp.pursnew file+21

@@ -0,0 +1,21 @@

1+module Data.Timestamp where

2+

3+import Prelude

4+import Data.Bifunctor (lmap)

5+import Data.DateTime (DateTime)

6+import Data.DateTime.Parsing as DateTime

7+import Data.Either (Either(..), either)

8+import Data.Maybe (maybe)

9+import Effect (Effect)

10+import Effect.Exception (throw)

11+

12+newtype Timestamp

13+ = Timestamp String

14+

15+toDateTime :: Timestamp -> Effect DateTime

16+toDateTime (Timestamp ts) =

17+ either throw pure

18+ $ lmap (const $ "Couldn't parse date: " <> ts) (DateTime.fromString ts)

19+ >>= (DateTime.toUTC >>> maybe (Left $ "Couldn't process date " <> ts) Right)

20+

21+foreign import toLocalDateTimeString :: Timestamp -> String

frontend/Bridge.elm+28−23

@@ -53,40 +53,47 @@ jsonEncCmd val =

5353

5454

5555

56−type alias Sub_Hello =

57− { first: String

58− , second: String

56+type alias Sub_LoadCiphers =

57+ { date: String

58+ , name: String

5959 }

6060

61−jsonDecSub_Hello : Json.Decode.Decoder ( Sub_Hello )

62−jsonDecSub_Hello =

63− Json.Decode.succeed (\pfirst psecond -> {first = pfirst, second = psecond})

64− |> required "first" (Json.Decode.string)

65− |> required "second" (Json.Decode.string)

61+jsonDecSub_LoadCiphers : Json.Decode.Decoder ( Sub_LoadCiphers )

62+jsonDecSub_LoadCiphers =

63+ Json.Decode.succeed (\pdate pname -> {date = pdate, name = pname})

64+ |> required "date" (Json.Decode.string)

65+ |> required "name" (Json.Decode.string)

6666

67−jsonEncSub_Hello : Sub_Hello -> Value

68−jsonEncSub_Hello val =

67+jsonEncSub_LoadCiphers : Sub_LoadCiphers -> Value

68+jsonEncSub_LoadCiphers val =

6969 Json.Encode.object

70− [ ("first", Json.Encode.string val.first)

71− , ("second", Json.Encode.string val.second)

70+ [ ("date", Json.Encode.string val.date)

71+ , ("name", Json.Encode.string val.name)

7272 ]

7373

7474

7575

76+type alias Sub_LoadCiphers_List = (List Sub_LoadCiphers)

77+

78+jsonDecSub_LoadCiphers_List : Json.Decode.Decoder ( Sub_LoadCiphers_List )

79+jsonDecSub_LoadCiphers_List =

80+ Json.Decode.list (jsonDecSub_LoadCiphers)

81+

82+jsonEncSub_LoadCiphers_List : Sub_LoadCiphers_List -> Value

83+jsonEncSub_LoadCiphers_List val = (Json.Encode.list jsonEncSub_LoadCiphers) val

84+

85+

86+

7687type Sub =

77− Empty

78− | Error String

79− | GotEverything String

80− | Hello Sub_Hello

88+ Error String

89+ | LoadCiphers Sub_LoadCiphers_List

8190 | NeedsLogin

8291

8392jsonDecSub : Json.Decode.Decoder ( Sub )

8493jsonDecSub =

8594 let jsonDecDictSub = Dict.fromList

86− [ ("Empty", Json.Decode.lazy (\_ -> Json.Decode.succeed Empty))

87− , ("Error", Json.Decode.lazy (\_ -> Json.Decode.map Error (Json.Decode.string)))

88− , ("GotEverything", Json.Decode.lazy (\_ -> Json.Decode.map GotEverything (Json.Decode.string)))

89− , ("Hello", Json.Decode.lazy (\_ -> Json.Decode.map Hello (jsonDecSub_Hello)))

95+ [ ("Error", Json.Decode.lazy (\_ -> Json.Decode.map Error (Json.Decode.string)))

96+ , ("LoadCiphers", Json.Decode.lazy (\_ -> Json.Decode.map LoadCiphers (jsonDecSub_LoadCiphers_List)))

9097 , ("NeedsLogin", Json.Decode.lazy (\_ -> Json.Decode.succeed NeedsLogin))

9198 ]

9299 jsonDecObjectSetSub = Set.fromList []

@@ -95,10 +102,8 @@ jsonDecSub =

95102jsonEncSub : Sub -> Value

96103jsonEncSub val =

97104 let keyval v = case v of

98− Empty -> ("Empty", encodeValue (Json.Encode.list identity []))

99105 Error v1 -> ("Error", encodeValue (Json.Encode.string v1))

100− GotEverything v1 -> ("GotEverything", encodeValue (Json.Encode.string v1))

101− Hello v1 -> ("Hello", encodeValue (jsonEncSub_Hello v1))

106+ LoadCiphers v1 -> ("LoadCiphers", encodeValue (jsonEncSub_LoadCiphers_List v1))

102107 NeedsLogin -> ("NeedsLogin", encodeValue (Json.Encode.list identity []))

103108 in encodeSumTaggedObject "tag" "contents" keyval val

104109

frontend/Main.elm+51−9

@@ -4,7 +4,9 @@ import Bridge

44import Browser

55import FFI exposing (getBridge)

66import Html exposing (..)

7+import Html.Attributes as Attr

78import Notification

9+import Pages.Ciphers as Ciphers

810import Pages.Loader exposing (loader)

911import Pages.Login as Login

1012import Pages.Navigation as Navigation

@@ -18,6 +20,8 @@ type Msg

1820 | CloseNotification

1921 | SubmitLogin { email : String, password : String, server : String }

2022 | LoginMsg Login.Msg

23+ | CiphersMsg Ciphers.Msg

24+ | LoadCiphers Bridge.Sub_LoadCiphers_List

2125

2226

2327type alias Model =

@@ -34,6 +38,7 @@ appendNotification cfg model =

3438type PageModel

3539 = LoginModel Login.Model

3640 | LoadingPage

41+ | CiphersModel Ciphers.Model

3742

3843

3944showPage : PageModel -> ( String, List (Html Msg) )

@@ -46,6 +51,13 @@ showPage page =

4651 in

4752 ( p.title model, p.view model )

4853

54+ CiphersModel model ->

55+ let

56+ p =

57+ Ciphers.page {} CiphersMsg

58+ in

59+ ( p.title model, p.view model )

60+

4961 LoadingPage ->

5062 ( "", [ loader ] )

5163

@@ -61,20 +73,14 @@ main =

6173 getBridge ShowError

6274 (\msg ->

6375 case msg of

64− Bridge.Hello { first, second } ->

65− RecieveMessage ("Got it! " ++ first ++ second)

66−

67− Bridge.GotEverything everything ->

68− RecieveMessage everything

69−

70− Bridge.Empty ->

71− RecieveMessage "Empty"

72−

7376 Bridge.NeedsLogin ->

7477 ShowLoginPage

7578

7679 Bridge.Error err ->

7780 ShowError err

81+

82+ Bridge.LoadCiphers ciphers ->

83+ LoadCiphers ciphers

7884 )

7985 }

8086

@@ -98,6 +104,25 @@ view model =

98104 [ Navigation.navigation { back = False, title = title }

99105 , main_ []

100106 (maybeList (List.head model.notifications) (Notification.notification CloseNotification)

107+ ++ [ div [ Attr.class "p-side-navigation--icons is-drawer-expanded" ]

108+ [ div [ Attr.class "p-side-navigation__overlay" ] []

109+ , nav [ Attr.class "p-side-navigation__drawer" ]

110+ [ div [ Attr.class "p-side-navigation__drawer-header" ]

111+ [ a [ Attr.class "p-side-navigation__toggle--in-drawer" ] [ text "mail@iko.soy" ]

112+ ]

113+ , ul [ Attr.class "p-side-navigation__list" ]

114+ (List.repeat 6

115+ (li [ Attr.class "p-side-navigation__item" ]

116+ [ a [ Attr.class "p-side-navigation__link" ]

117+ [ i [ Attr.class "p-icon--help p-side-navigation__icon" ] []

118+ , text "Users"

119+ ]

120+ ]

121+ )

122+ )

123+ ]

124+ ]

125+ ]

101126 ++ body

102127 )

103128 ]

@@ -161,11 +186,28 @@ update msg model =

161186 _ ->

162187 ( model, Cmd.none )

163188

189+ CiphersMsg imsg ->

190+ case model.page of

191+ CiphersModel page ->

192+ (Ciphers.page ciphersCallbacks CiphersMsg).update imsg page |> processPage CiphersModel

193+

194+ _ ->

195+ ( model, Cmd.none )

196+

164197 ShowLoginPage ->

165198 (Login.page loginCallbacks LoginMsg).init ()

166199 |> Tuple.mapFirst (\pageModel -> { model | page = LoginModel pageModel })

167200

201+ LoadCiphers ciphers ->

202+ (Ciphers.page ciphersCallbacks CiphersMsg).init ciphers

203+ |> Tuple.mapFirst (\pageModel -> { model | page = CiphersModel pageModel })

204+

168205

169206loginCallbacks : Login.Callbacks Msg

170207loginCallbacks =

171208 { submit = SubmitLogin }

209+

210+

211+ciphersCallbacks : Ciphers.Callbacks

212+ciphersCallbacks =

213+ {}

frontend/Pages/Ciphers.elmnew file+67

@@ -0,0 +1,67 @@

1+module Pages.Ciphers exposing (Callbacks, Model, Msg, page)

2+

3+import Bridge

4+import Html exposing (..)

5+import Html.Attributes as Attr

6+import Html.Events as Ev

7+import Page exposing (..)

8+import Utils exposing (..)

9+

10+

11+type alias Model =

12+ { ciphers : Bridge.Sub_LoadCiphers_List

13+ }

14+

15+

16+type Msg

17+ = Noop

18+

19+

20+type alias Callbacks =

21+ {}

22+

23+

24+page : Callbacks -> Page Bridge.Sub_LoadCiphers_List Model Msg emsg

25+page callbacks liftMsg =

26+ { init = \ciphers -> Tuple.mapSecond (Cmd.map liftMsg) (init ciphers)

27+ , view = \model -> view model |> List.map (Html.map liftMsg)

28+ , update = \msg model -> update callbacks liftMsg msg model

29+ , subscriptions = \model -> subscriptions model |> Sub.map liftMsg

30+ , title = always "Passwords"

31+ }

32+

33+

34+init : Bridge.Sub_LoadCiphers_List -> ( Model, Cmd Msg )

35+init ciphers =

36+ ( { ciphers = ciphers }

37+ , Cmd.none

38+ )

39+

40+

41+update : Callbacks -> (Msg -> emsg) -> Msg -> Model -> ( Result String Model, Cmd emsg )

42+update {} liftMsg msg model =

43+ case msg of

44+ Noop ->

45+ ( Ok model, Cmd.none )

46+

47+

48+subscriptions : Model -> Sub Msg

49+subscriptions model =

50+ Sub.none

51+

52+

53+view : Model -> List (Html Msg)

54+view { ciphers } =

55+ [ ul [ Attr.class "p-list--divided" ]

56+ (List.map

57+ (\{ name, date } ->

58+ li [ Attr.class "p-list__item cipher-row" ]

59+ [ div [ Attr.class "cipher-row-container" ]

60+ [ p [] [ text name ]

61+ , p [ Attr.class "p-text--small u-align-text--right u-text--muted" ] [ text date ]

62+ ]

63+ ]

64+ )

65+ ciphers

66+ )

67+ ]

frontend/Pages/Navigation.elm+31

@@ -22,3 +22,34 @@ navigation { back, title } =

2222 , text title

2323 ]

2424 ]

25+

26+

27+type alias MenuConfig msg =

28+ { title : String

29+ , items : List { icon : String, name : String, trigger : msg }

30+ , close : msg

31+ }

32+

33+

34+menu : MenuConfig msg -> Html msg

35+menu { title, items, close } =

36+ div [ Attr.class "p-side-navigation--icons is-drawer-expanded" ]

37+ [ div [ Attr.class "p-side-navigation__overlay" ] []

38+ , nav [ Attr.class "p-side-navigation__drawer" ]

39+ [ div [ Attr.class "p-side-navigation__drawer-header" ]

40+ [ a [ Attr.class "p-side-navigation__toggle--in-drawer" ] [ text title ]

41+ ]

42+ , ul [ Attr.class "p-side-navigation__list" ]

43+ (items

44+ |> List.map

45+ (\{ icon, name, trigger } ->

46+ li [ Attr.class "p-side-navigation__item" ]

47+ [ a [ Attr.class "p-side-navigation__link" ]

48+ [ i [ Attr.class "p-side-navigation__icon", Attr.class ("p-icon--" ++ icon) ] []

49+ , text name

50+ ]

51+ ]

52+ )

53+ )

54+ ]

55+ ]

spago.dhall+3

@@ -17,11 +17,14 @@ to generate this file without the comments in this block.

1717 , "argonaut"

1818 , "argonaut-aeson-generic"

1919 , "argonaut-codecs"

20+ , "arrays"

2021 , "bw"

2122 , "console"

2223 , "datetime"

24+ , "datetime-parsing"

2325 , "effect"

2426 , "either"

27+ , "el"

2528 , "exceptions"

2629 , "foldable-traversable"

2730 , "foreign"

style.css+18

@@ -14,6 +14,7 @@ nav.p-tabs__list {

1414 background-color: white;

1515 padding-bottom: 1rem;

1616 padding-bottom: 0;

17+ z-index: 10;

1718}

1819

1920.ninety-counter {

@@ -40,3 +41,20 @@ nav.p-tabs__list {

4041.spinner{

4142 padding: 1rem;

4243}

44+

45+.cipher-row-container {

46+ display: flex;

47+ width: 100%;

48+ align-items: baseline;

49+ justify-content: space-between;

50+ flex-direction: row;

51+ flex-wrap: wrap;

52+}

53+

54+.cipher-row p {

55+ margin-bottom: 0.5rem;

56+}

57+

58+.cipher-row .p-text--small {

59+ margin-bottom: 0.5rem;

60+}