27aaecc · warden · git.iko.soy

git.iko.soy/warden

Got logins really working

commit27aaecc6278f5c3da1e278ca7f37770dfeb93f43 authoriko <ilyakooo0@gmail.com> dateThu 28 Jul 2022, 17:52 (4 years ago) parent0c13770

26 files changed+697−206

compare with master

unifiedsplit

bw/src/BW.js → backend/BW.js+3−2 backend/BW.purs+78 bw/src/BW/Logic.purs → backend/BW/Logic.purs+18−13 bw/src/BW/Types.purs → backend/BW/Types.purs+75−63 backend/Bridge.purs+20 bw/src/Data/EncString.js → backend/Data/EncString.js bw/src/Data/EncString.purs → backend/Data/EncString.purs backend/Data/JNullable.purs+27 backend/Data/JOpt.purs+20 backend/Data/ShowableJson.purs+19 bw/src/Data/SymmetricCryptoKey.js → backend/Data/SymmetricCryptoKey.js bw/src/Data/SymmetricCryptoKey.purs → backend/Data/SymmetricCryptoKey.purs+3−3 bw/src/Data/Timestamp.js → backend/Data/Timestamp.js bw/src/Data/Timestamp.purs → backend/Data/Timestamp.purs+8 backend/Localstorage.purs+33 backend/Main.purs+147−30 bridge.yaml+9 bw/spago.dhall−20 bw/src/BW.purs−34 bw/src/Data/ShowableJson.purs−14 el/test/Main.purs+10−10 frontend/Bridge.elm+38 frontend/Main.elm+73−15 frontend/Pages/MasterPassword.elm+85 packages.dhall+20−1 spago.dhall+11−1

bw/src/BW.js → backend/BW.jsrenamed+3−2

@@ -9,7 +9,7 @@ import { TokenService } from "../../deps/bw/libs/shared/dist/src/services/token.

99import { WebCryptoFunctionService } from "../../deps/bw/libs/shared/dist/src/services/webCryptoFunction.service";

1010import { Account, AccountProfile, AccountTokens } from "../../deps/bw/libs/shared/dist/src/models/domain/account";

1111

12−// import BrowserStorageService from "../../deps/bw/libs/shared/dist/src/services/browserStorage.service";

12+// import BrowserStorageService from "../../../../deps/bw/libs/shared/dist/src/services/browserStorage.service";

1313import { CryptoService } from "../../deps/bw/libs/shared/dist/src/services/crypto.service";

1414

1515import { I18nService } from "../../deps/bw/libs/shared/dist/src/services/i18n.service";

@@ -74,7 +74,8 @@ export function getServices() {

7474 getSync: () => api.getSync().then(sanitize),

7575 }

7676 },

77− crypto: bg.cryptoService

77+ crypto: bg.cryptoService,

78+ cryptoFunctions: bg.cryptoFunctionService

7879 }

7980}

8081

backend/BW.pursnew file+78

@@ -0,0 +1,78 @@

1+module BW where

3+import BW.Types

4+import Prelude

6+import Control.Promise (Promise)

7+import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson)

8+import Data.ArrayBuffer.Typed as AB

9+import Data.ArrayBuffer.Types (ArrayBuffer, ArrayView, Int32)

10+import Data.EncString (EncString)

11+import Data.Function.Uncurried (Fn2, Fn3, Fn4)

12+import Data.JNullable (JNullable)

13+import Data.SymmetricCryptoKey (SymmetricCryptoKey)

14+import Effect (Effect)

15+import Effect.Unsafe (unsafePerformEffect)

16+

17+type CryptoService

18+ = { makeKey :: Fn4 Password String KDF Int (Promise SymmetricCryptoKey)

19+ , hashPassword :: Fn3 Password SymmetricCryptoKey (JNullable HashPurpose) (Promise StringHash)

20+ , decryptToUtf8 :: Fn2 EncString SymmetricCryptoKey (Promise String)

21+ , decryptToBytes :: Fn2 EncString SymmetricCryptoKey (Promise ArrayBuffer)

22+ , stretchKey :: SymmetricCryptoKey -> Promise SymmetricCryptoKey

23+ }

24+

25+type ApiService

26+ = { postPrelogin :: PreloginRequest -> Promise PreloginResponse

27+ , getProfile :: Unit -> Promise ProfileResponse

28+ -- TODO: There can really be more request and response types. Maybe handle this later.

29+ , postIdentityToken :: PasswordTokenRequest -> Promise IdentityTokenResponse

30+ , getSync :: Unit -> Promise SyncResponse

31+ }

32+

33+cryptoFunctionsTypeSha1 = "sha1" :: CryptoFunctionsType

34+

35+cryptoFunctionsTypeSha256 = "sha256" :: CryptoFunctionsType

36+

37+cryptoFunctionsTypeSha512 = "sha512" :: CryptoFunctionsType

38+

39+cryptoFunctionsTypeMd5 = "md5" :: CryptoFunctionsType

40+

41+type CryptoFunctionsType

42+ = String

43+

44+type CryptoFunctions

45+ = { hash :: Fn2 String CryptoFunctionsType (Promise Hash)

46+ }

47+

48+newtype Hash

49+ = Hash (ArrayBuffer)

50+

51+hashToArray :: Hash -> Array Int

52+hashToArray (Hash buf) =

53+ unsafePerformEffect do

54+ av :: ArrayView Int32 <- AB.whole buf

55+ AB.toArray av

56+

57+arrayToHash :: Array Int -> Hash

58+arrayToHash arr =

59+ unsafePerformEffect do

60+ av :: ArrayView Int32 <- AB.fromArray arr

61+ pure $ Hash $ AB.buffer av

62+

63+instance Eq Hash where

64+ eq a b = eq (hashToArray a) (hashToArray b)

65+

66+instance EncodeJson Hash where

67+ encodeJson = hashToArray >>> encodeJson

68+

69+instance DecodeJson Hash where

70+ decodeJson = decodeJson >>> map arrayToHash

71+

72+type Services

73+ = { crypto :: CryptoService

74+ , getApi :: Urls -> JNullable IdentityTokenResponse -> Promise ApiService

75+ , cryptoFunctions :: CryptoFunctions

76+ }

77+

78+foreign import getServices :: Effect Services

bw/src/BW/Logic.purs → backend/BW/Logic.pursrenamed+18−13

@@ -9,8 +9,8 @@ import Control.Promise (Promise)

99import Control.Promise as Promise

1010import Data.EncString as EncString

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

12+import Data.JNullable (jnull, nullify)

1213import Data.Maybe (Maybe(..))

13−import Data.Nullable (null, toNullable)

1414import Data.String as String

1515import Data.SymmetricCryptoKey (SymmetricCryptoKey)

1616import Data.SymmetricCryptoKey as SymmetricCryptoKey

@@ -19,19 +19,19 @@ import Effect.Class (liftEffect)

1919import Effect.Class.Console (log)

2020import Effect.Exception (error)

2121import Effect.Exception as Exc

22+import Localstorage (class StorageKey)

23+import Web.Storage.Storage (Storage)

2224

25+-- | Creates the master key

2326makePreloginKey ::

2427 forall r.

25− HasL "api" ApiService r =>

2628 HasL "crypto" CryptoService r =>

27− Email -> Password -> Al r SymmetricCryptoKey

28−makePreloginKey (Email email') (Password password) = do

29− api :: ApiService <- l (L :: L "api")

29+ PreloginResponse -> Email -> Password -> Al r SymmetricCryptoKey

30+makePreloginKey { kdf, kdfIterations } (Email email') password = do

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

3132 let

3233 email = (String.trim >>> String.toLower) email'

33− { kdf, kdfIterations } <- liftPromise $ api.postPrelogin { email }

34− liftPromise $ runFn4 crypto.makeKey (Password password) email kdf kdfIterations

34+ liftPromise $ runFn4 crypto.makeKey password email kdf kdfIterations

3535

3636makeDecryptionKey ::

3737 forall r.

@@ -58,15 +58,15 @@ getLogInRequestToken ::

5858 forall r.

5959 HasL "api" ApiService r =>

6060 HasL "crypto" CryptoService r =>

61− Email -> Password -> Al r IdentityTokenResponse

62−getLogInRequestToken email password = do

63− key <- makePreloginKey email password

61+ PreloginResponse -> Email -> Password -> Al r IdentityTokenResponse

62+getLogInRequestToken prelogin email password = do

63+ key <- makePreloginKey prelogin email password

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

6565 api :: ApiService <- l (L :: L "api")

6666 _localHashedPassword <-

6767 liftPromise

68− $ runFn3 crypto.hashPassword password key (toNullable $ Just hashPurposeLocalAuthorization)

69− Hash hashedPassword <- liftPromise $ runFn3 crypto.hashPassword password key null

68+ $ runFn3 crypto.hashPassword password key (nullify hashPurposeLocalAuthorization)

69+ StringHash hashedPassword <- liftPromise $ runFn3 crypto.hashPassword password key jnull

7070 liftPromise

7171 $ api.postIdentityToken

7272 { email: email

@@ -81,10 +81,15 @@ getLogInRequestToken email password = do

8181 { type: deviceTypeUnknownBrowser

8282 , name: "Temporary device name"

8383 , identifier: "42"

84− , pushToken: null

84+ , pushToken: jnull

8585 }

8686 }

8787

88+hashPassword :: forall r. HasL "cryptoFunctions" CryptoFunctions r => Password -> Al r Hash

89+hashPassword (Password password) = do

90+ cryptoFunctions <- l (L :: L "cryptoFunctions")

91+ liftPromise $ runFn2 cryptoFunctions.hash password cryptoFunctionsTypeSha512

92+

8893decrypt ::

8994 forall r.

9095 HasL "crypto" CryptoService r =>

bw/src/BW/Types.purs → backend/BW/Types.pursrenamed+75−63

@@ -2,17 +2,21 @@ module BW.Types where

33import Prelude

5−import Data.ArrayBuffer.Types (ArrayBuffer)

5+import Data.Argonaut (class DecodeJson, class EncodeJson)

66import Data.Date (Date)

7−import Data.Nullable (Nullable)

7+import Data.JNullable (JNullable)

8+import Data.JOpt (JOpt)

89import Data.ShowableJson (ShowableJson)

910import Data.Timestamp (Timestamp(..))

10−import Data.Undefined.NoProblem (Opt)

1111

1212newtype EncryptedString

1313 = EncryptedString String

1414

1515derive newtype instance Show EncryptedString

16+derive newtype instance Ord EncryptedString

17+derive newtype instance Eq EncryptedString

18+derive newtype instance EncodeJson EncryptedString

19+derive newtype instance DecodeJson EncryptedString

1620

1721kdfPBKDF2_SHA256 = 0 :: KDF

1822

@@ -35,7 +39,7 @@ type ProfileResponse

3539 , emailVerified :: Boolean

3640 , masterPasswordHint :: String

3741 , premiumPersonally :: Boolean

38− , premiumFromOrganization :: Boolean

42+ -- , premiumFromOrganization :: Boolean

3943 , culture :: String

4044 , twoFactorEnabled :: Boolean

4145 , key :: EncryptedString

@@ -65,7 +69,7 @@ type ProfileOrganizationResponse

6569 , usersGetPremium :: Boolean

6670 , seats :: Int

6771 , maxCollections :: Int

68− , maxStorageGb :: Nullable Int

72+ , maxStorageGb :: JNullable Int

6973 , key :: String

7074 , hasPublicAndPrivateKeys :: Boolean

7175 , status :: OrganizationUserStatusType

@@ -83,9 +87,9 @@ type ProfileOrganizationResponse

8387 , planProductType :: ProductType

8488 , keyConnectorEnabled :: Boolean

8589 , keyConnectorUrl :: String

86− , familySponsorshipLastSyncDate :: Nullable Date

87− , familySponsorshipValidUntil :: Nullable Date

88− , familySponsorshipToDelete :: Nullable Boolean

90+ , familySponsorshipLastSyncDate :: JNullable Timestamp

91+ , familySponsorshipValidUntil :: JNullable Timestamp

92+ , familySponsorshipToDelete :: JNullable Boolean

8993 }

9094

9195organizationUserStatusTypeInvited = 0 :: OrganizationUserStatusType

@@ -185,7 +189,7 @@ type ProfileProviderOrganizationResponse

185189 , usersGetPremium :: Boolean

186190 , seats :: Int

187191 , maxCollections :: Int

188− , maxStorageGb :: Nullable Int

192+ , maxStorageGb :: JNullable Int

189193 , key :: String

190194 , hasPublicAndPrivateKeys :: Boolean

191195 , status :: OrganizationUserStatusType

@@ -203,20 +207,20 @@ type ProfileProviderOrganizationResponse

203207 , planProductType :: ProductType

204208 , keyConnectorEnabled :: Boolean

205209 , keyConnectorUrl :: String

206− , familySponsorshipLastSyncDate :: Nullable Date

207− , familySponsorshipValidUntil :: Nullable Date

208− , familySponsorshipToDelete :: Nullable Boolean

210+ , familySponsorshipLastSyncDate :: JNullable Timestamp

211+ , familySponsorshipValidUntil :: JNullable Timestamp

212+ , familySponsorshipToDelete :: JNullable Boolean

209213 }

210214

211215type Urls

212− = { base :: Nullable String

213− , webVault :: Nullable String

214− , api :: Nullable String

215− , identity :: Nullable String

216− , icons :: Nullable String

217− , notifications :: Nullable String

218− , events :: Nullable String

219− , keyConnector :: Nullable String

216+ = { base :: JNullable String

217+ , webVault :: JNullable String

218+ , api :: JNullable String

219+ , identity :: JNullable String

220+ , icons :: JNullable String

221+ , notifications :: JNullable String

222+ , events :: JNullable String

223+ , keyConnector :: JNullable String

220224 }

221225

222226type PasswordTokenRequest

@@ -231,7 +235,7 @@ type DeviceRequest

231235 = { type :: DeviceType

232236 , name :: String

233237 , identifier :: String

234− , pushToken :: Nullable String

238+ , pushToken :: JNullable String

235239 }

236240

237241deviceTypeAndroid = 0 :: DeviceType

@@ -314,18 +318,26 @@ hashPurposeLocalAuthorization = 2 :: HashPurpose

314318type HashPurpose

315319 = Int

316320

317−newtype Hash

318− = Hash String

321+newtype StringHash

322+ = StringHash String

319323

320324newtype AccessToken

321325 = AccessToken String

322326

323327derive newtype instance Show AccessToken

328+derive newtype instance Eq AccessToken

329+derive newtype instance Ord AccessToken

330+derive newtype instance EncodeJson AccessToken

331+derive newtype instance DecodeJson AccessToken

324332

325333newtype RefreshToken

326334 = RefreshToken String

327335

328336derive newtype instance Show RefreshToken

337+derive newtype instance Eq RefreshToken

338+derive newtype instance Ord RefreshToken

339+derive newtype instance EncodeJson RefreshToken

340+derive newtype instance DecodeJson RefreshToken

329341

330342

331343type IdentityTokenResponse

@@ -336,12 +348,12 @@ type IdentityTokenResponse

336348 , resetMasterPassword :: Boolean

337349 , privateKey :: EncryptedString

338350 , key :: EncryptedString

339− , twoFactorToken :: Nullable String

351+ , twoFactorToken :: JNullable String

340352 , kdf :: KDF

341353 , kdfIterations :: Int

342− , forcePasswordReset :: Nullable Boolean

343− , apiUseKeyConnector :: Nullable Boolean

344− , keyConnectorUrl :: Nullable String

354+ , forcePasswordReset :: JNullable Boolean

355+ , apiUseKeyConnector :: JNullable Boolean

356+ , keyConnectorUrl :: JNullable String

345357 }

346358

347359newtype Email

@@ -352,8 +364,8 @@ type SyncResponse

352364 , folders :: Array FolderResponse

353365 , collections :: Array CollectionDetailsResponse

354366 , ciphers :: Array CipherResponse

355− , domains :: Nullable DomainsResponse

356− , policies :: Nullable (Array PolicyResponse)

367+ , domains :: JNullable DomainsResponse

368+ , policies :: JNullable (Array PolicyResponse)

357369 , sends :: Array SendResponse

358370 }

359371

@@ -365,33 +377,33 @@ type FolderResponse

365377

366378type CollectionDetailsResponse

367379 = { id :: String

368− , organizationId :: Nullable String

380+ , organizationId :: JNullable String

369381 , name :: String

370− , externalId :: Nullable String

382+ , externalId :: JNullable String

371383 , readOnly :: Boolean

372384 }

373385

374386type CipherResponse

375387 = { id :: String

376− , organizationId :: Nullable String

377− , folderId :: Nullable String

388+ , organizationId :: JNullable String

389+ , folderId :: JNullable String

378390 , type :: CipherType

379391 , name :: EncryptedString

380− , notes :: Nullable EncryptedString

381− , fields :: Nullable (Array FieldApi)

382− , login :: Nullable LoginApi

383− , card :: Nullable CardApi

384− , identity :: Nullable IdentityApi

385− , secureNote :: Nullable SecureNoteApi

392+ , notes :: JNullable EncryptedString

393+ , fields :: JNullable (Array FieldApi)

394+ , login :: JNullable LoginApi

395+ , card :: JNullable CardApi

396+ , identity :: JNullable IdentityApi

397+ , secureNote :: JNullable SecureNoteApi

386398 , favorite :: Boolean

387399 , edit :: Boolean

388400 , viewPassword :: Boolean

389401 , organizationUseTotp :: Boolean

390402 , revisionDate :: Timestamp

391− , attachments :: Nullable (Array AttachmentResponse)

392− , passwordHistory :: Nullable (Array PasswordHistoryResponse)

393− , collectionIds :: Nullable (Array String)

394− , deletedDate :: Nullable String

403+ , attachments :: JNullable (Array AttachmentResponse)

404+ , passwordHistory :: JNullable (Array PasswordHistoryResponse)

405+ , collectionIds :: JNullable (Array String)

406+ , deletedDate :: JNullable String

395407 , reprompt :: CipherRepromptType

396408 }

397409

@@ -410,7 +422,7 @@ type FieldApi

410422 = { name :: String

411423 , value :: String

412424 , type :: FieldType

413− , linkedId :: Nullable LinkedIdType

425+ , linkedId :: JNullable LinkedIdType

414426 }

415427

416428fieldTypeText = 0 :: FieldType

@@ -482,18 +494,18 @@ type LinkedIdType

482494 = Int

483495

484496type LoginApi

485− = { uris :: Opt (Array LoginUriApi)

486− , username :: Nullable EncryptedString

487− , password :: Nullable EncryptedString

488− , passwordRevisionDate :: Nullable String

489− , totp :: Nullable EncryptedString

497+ = { uris :: JOpt (Array LoginUriApi)

498+ , username :: JNullable EncryptedString

499+ , password :: JNullable EncryptedString

500+ , passwordRevisionDate :: JNullable String

501+ , totp :: JNullable EncryptedString

490502 -- This thing is undefined in some cases for some reson. Just ignoring it

491− , autofillOnPageLoad :: Opt (Nullable Boolean)

503+ , autofillOnPageLoad :: JOpt (JNullable Boolean)

492504 }

493505

494506type LoginUriApi

495507 = { uri :: String

496− , match :: Nullable UriMatchType

508+ , match :: JNullable UriMatchType

497509 }

498510

499511uriMatchTypeDomain = 0 :: UriMatchType

@@ -512,12 +524,12 @@ type UriMatchType

512524 = Int

513525

514526type CardApi

515− = { cardholderName :: Nullable String

516− , brand :: Nullable String

517− , number :: Nullable String

518− , expMonth :: Nullable String

519− , expYear :: Nullable String

520− , code :: Nullable String

527+ = { cardholderName :: JNullable String

528+ , brand :: JNullable String

529+ , number :: JNullable String

530+ , expMonth :: JNullable String

531+ , expYear :: JNullable String

532+ , code :: JNullable String

521533 }

522534

523535type IdentityApi

@@ -580,7 +592,7 @@ type GlobalDomainResponse

580592

581593type PolicyResponse

582594 = { id :: String

583− , organizationId :: Nullable String

595+ , organizationId :: JNullable String

584596 , type :: PolicyType

585597 , data :: ShowableJson

586598 , enabled :: Boolean

@@ -616,15 +628,15 @@ type SendResponse

616628 , accessId :: String

617629 , type :: SendType

618630 , name :: String

619− , notes :: Nullable String

620− , file :: Nullable SendFileApi

621− , text :: Nullable SendTextApi

631+ , notes :: JNullable String

632+ , file :: JNullable SendFileApi

633+ , text :: JNullable SendTextApi

622634 , key :: String

623− , maxAccessCount :: Nullable Int

635+ , maxAccessCount :: JNullable Int

624636 , accessCount :: Int

625637 , revisionDate :: String

626638 , expirationDate :: String

627− , deletionDate :: Nullable String

639+ , deletionDate :: JNullable String

628640 , password :: String

629641 , disable :: Boolean

630642 , hideEmail :: Boolean

backend/Bridge.purs+20

@@ -30,6 +30,9 @@ derive instance ordCmd_Login :: Ord Cmd_Login

3030data Cmd =

3131 Init

3232 | Login Cmd_Login

33+ | NeedCiphersList

34+ | NeedsReset

35+ | SendMasterPassword String

3336

3437instance encodeJsonCmd :: EncodeJson Cmd where

3538 encodeJson = genericEncodeAeson Argonaut.defaultOptions

@@ -64,10 +67,27 @@ derive instance genericSub_LoadCiphers_List :: Generic Sub_LoadCiphers_List _

6467derive instance eqSub_LoadCiphers_List :: Eq Sub_LoadCiphers_List

6568derive instance ordSub_LoadCiphers_List :: Ord Sub_LoadCiphers_List

6669

70+newtype Sub_NeedsMasterPassword =

71+ Sub_NeedsMasterPassword {

72+ login :: String

73+ , server :: String

74+ }

75+

76+instance encodeJsonSub_NeedsMasterPassword :: EncodeJson Sub_NeedsMasterPassword where

77+ encodeJson = genericEncodeAeson Argonaut.defaultOptions

78+instance decodeJsonSub_NeedsMasterPassword :: DecodeJson Sub_NeedsMasterPassword where

79+ decodeJson = genericDecodeAeson Argonaut.defaultOptions

80+derive instance genericSub_NeedsMasterPassword :: Generic Sub_NeedsMasterPassword _

81+derive instance eqSub_NeedsMasterPassword :: Eq Sub_NeedsMasterPassword

82+derive instance ordSub_NeedsMasterPassword :: Ord Sub_NeedsMasterPassword

83+

6784data Sub =

6885 Error String

6986 | LoadCiphers Sub_LoadCiphers_List

87+ | LoginSuccessful

7088 | NeedsLogin

89+ | NeedsMasterPassword Sub_NeedsMasterPassword

90+ | Reset

7191

7292instance encodeJsonSub :: EncodeJson Sub where

7393 encodeJson = genericEncodeAeson Argonaut.defaultOptions

bw/src/Data/EncString.js → backend/Data/EncString.jsrenamed

The content is the same.

bw/src/Data/EncString.purs → backend/Data/EncString.pursrenamed

The content is the same.

backend/Data/JNullable.pursnew file+27

@@ -0,0 +1,27 @@

1+module Data.JNullable where

3+import Prelude

5+import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson)

6+import Data.Maybe (Maybe(..))

7+import Data.Nullable (Nullable, null, toNullable)

8+import Data.Nullable as Nullable

10+newtype JNullable a

11+ = JNullable (Nullable a)

12+

13+derive newtype instance Eq a => Eq (JNullable a)

14+derive newtype instance Ord a => Ord (JNullable a)

15+derive newtype instance Show a => Show (JNullable a)

16+

17+instance EncodeJson a => EncodeJson (JNullable a) where

18+ encodeJson (JNullable a) = encodeJson $ Nullable.toMaybe a

19+

20+instance DecodeJson a => DecodeJson (JNullable a) where

21+ decodeJson json = JNullable <<< Nullable.toNullable <$> decodeJson json

22+

23+jnull :: forall a. JNullable a

24+jnull = JNullable null

25+

26+nullify :: forall a. a -> JNullable a

27+nullify = Just >>> toNullable >>> JNullable

backend/Data/JOpt.pursnew file+20

@@ -0,0 +1,20 @@

1+module Data.JOpt where

3+import Prelude

5+import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson)

6+import Data.Undefined.NoProblem (Opt)

7+import Data.Undefined.NoProblem as Opt

9+newtype JOpt a

10+ = JOpt (Opt a)

11+

12+derive newtype instance Eq a => Eq (JOpt a)

13+derive newtype instance Ord a => Ord (JOpt a)

14+derive newtype instance Show a => Show (JOpt a)

15+

16+instance EncodeJson a => EncodeJson (JOpt a) where

17+ encodeJson (JOpt a) = encodeJson $ Opt.toMaybe a

18+

19+instance DecodeJson a => DecodeJson (JOpt a) where

20+ decodeJson json = JOpt <<< Opt.fromMaybe <$> decodeJson json

backend/Data/ShowableJson.pursnew file+19

@@ -0,0 +1,19 @@

1+module Data.ShowableJson

2+ ( ShowableJson(..)

3+ )

4+ where

6+import Prelude

8+import Data.Argonaut (class DecodeJson, class EncodeJson, Json)

9+import Data.Argonaut as Json

10+

11+newtype ShowableJson = ShowableJson Json

12+

13+instance Show ShowableJson where

14+ show (ShowableJson x) = Json.stringify x

15+

16+derive newtype instance Eq ShowableJson

17+derive newtype instance Ord ShowableJson

18+derive newtype instance EncodeJson ShowableJson

19+derive newtype instance DecodeJson ShowableJson

bw/src/Data/SymmetricCryptoKey.js → backend/Data/SymmetricCryptoKey.jsrenamed

The content is the same.

bw/src/Data/SymmetricCryptoKey.purs → backend/Data/SymmetricCryptoKey.pursrenamed+3−3

@@ -2,12 +2,12 @@ module Data.SymmetricCryptoKey where

33import Prelude

44import Data.ArrayBuffer.Types (ArrayBuffer)

5−import Data.Nullable (Nullable)

5+import Data.JNullable (JNullable)

77type SymmetricCryptoKey

88 = { key :: ArrayBuffer

9− , encKey :: Nullable ArrayBuffer

10− , macKey :: Nullable ArrayBuffer

9+ , encKey :: JNullable ArrayBuffer

10+ , macKey :: JNullable ArrayBuffer

1111 , encType :: EncryptionType

1212 , keyB64 :: String

1313 , encKeyB64 :: String

bw/src/Data/Timestamp.js → backend/Data/Timestamp.jsrenamed

The content is the same.

bw/src/Data/Timestamp.purs → backend/Data/Timestamp.pursrenamed+8

@@ -1,6 +1,8 @@

11module Data.Timestamp where

33import Prelude

5+import Data.Argonaut (class DecodeJson, class EncodeJson)

46import Data.Bifunctor (lmap)

57import Data.DateTime (DateTime)

68import Data.DateTime.Parsing as DateTime

@@ -12,6 +14,12 @@ import Effect.Exception (throw)

1214newtype Timestamp

1315 = Timestamp String

1416

17+derive newtype instance Show Timestamp

18+derive newtype instance Ord Timestamp

19+derive newtype instance Eq Timestamp

20+derive newtype instance EncodeJson Timestamp

21+derive newtype instance DecodeJson Timestamp

22+

1523toDateTime :: Timestamp -> Effect DateTime

1624toDateTime (Timestamp ts) =

1725 either throw pure

backend/Localstorage.pursnew file+33

@@ -0,0 +1,33 @@

1+module Localstorage where

3+import Prelude

4+import Data.Argonaut (class DecodeJson, class EncodeJson)

5+import Data.Argonaut as Json

6+import Data.Either (Either(..))

7+import Data.Maybe (Maybe(..))

8+import Effect (Effect)

9+import Effect.Exception as Exc

10+import Type.Prelude (Proxy)

11+import Web.Storage.Storage (Storage)

12+import Web.Storage.Storage as Storage

13+

14+class TypeId a where

15+ typeId :: Proxy a -> String

16+

17+class StorageKey k t | k -> t where

18+ storageKey :: k -> String

19+

20+store :: forall k t. StorageKey k t => EncodeJson t => Storage -> k -> t -> Effect Unit

21+store storage key t = Storage.setItem (storageKey key) (Json.stringify $ Json.encodeJson $ t) storage

22+

23+get :: forall k t. StorageKey k t => DecodeJson t => Storage -> k -> Effect (Maybe t)

24+get storage key =

25+ Storage.getItem (storageKey key) storage

26+ >>= \x -> case x of

27+ Nothing -> pure Nothing

28+ Just y -> case Json.parseJson y >>= Json.decodeJson of

29+ Left err -> Exc.throw $ Json.printJsonDecodeError err

30+ Right y -> pure $ Just y

31+

32+delete :: forall k t. StorageKey k t => Storage -> k -> Effect Unit

33+delete storage key = Storage.removeItem (storageKey key) storage

backend/Main.purs+147−30

@@ -4,20 +4,22 @@ module Main

55import Bridge

66import Prelude

7−import BW (CryptoService)

8+import BW (ApiService, CryptoService, Hash(..), Services)

89import BW as WB

9−import BW.Logic (decrypt, liftPromise)

10+import BW.Logic (decrypt, hashPassword, liftPromise)

1011import BW.Logic as Logic

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

12+import BW.Types (CipherResponse, Email(..), EncryptedString(..), IdentityTokenResponse, Password(..), PreloginResponse, SyncResponse, Urls, PreloginRequest)

1213import Bridge as Bridge

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

1415import Control.Monad.Reader (runReaderT)

1516import Control.Promise (Promise)

1617import Control.Promise as Promise

17−import Data.Argonaut (class EncodeJson, encodeJson)

18+import Data.Argonaut (class DecodeJson, class EncodeJson, encodeJson)

1819import Data.Argonaut as Json

1920import Data.Array as A

2021import Data.Either (Either(..))

22+import Data.JNullable (JNullable(..), jnull, nullify)

2123import Data.Maybe (Maybe(..))

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

2325import Data.Nullable as Nullable

@@ -32,40 +34,124 @@ import Effect.Aff.Class as Aff

3234import Effect.Class (liftEffect)

3335import Effect.Class.Console (log)

3436import Effect.Exception as Exc

37+import Effect.Ref as Ref

3538import Elm as Elm

39+import FFI (Elm)

3640import FFI as FFI

41+import Localstorage (class StorageKey, storageKey)

42+import Localstorage as Storage

43+import Localstorage as Storage

3744import Prelude as Array

3845import Unsafe.Coerce (unsafeCoerce)

46+import Web.HTML (Window)

47+import Web.HTML as Html

48+import Web.HTML.Window as Window

49+import Web.Storage.Storage (Storage)

50+import Web.Storage.Storage as WebStorage

3951

4052main :: Effect Unit

4153main = do

4254 app <- FFI.startElm "elm"

55+ storage <- Html.window >>= Window.localStorage

4356 services <- WB.getServices

57+ masterKeyRef <- Ref.new Nothing

58+ let run act = do

59+ maybeKey <- Ref.read masterKeyRef

60+ runElmAff app $ flip runReaderT {app: app, crypto : services.crypto, storage: storage} $

61+ case maybeKey of

62+ Just masterKey -> do

63+ token <- getOrReset storage TokenKey

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

65+ liftEffect $ runElmAff app $ runReaderT act

66+ {app : app , storage : storage, services : services, crypto : services.crypto

67+ , key : key}

68+ Nothing -> requestMasterPassword

4469 Elm.subscribe app \cmd -> case cmd of

4570 Bridge.Login (Bridge.Cmd_Login { email, server, password }) -> do

4671 let

4772 urls = baseUrl server

4873 runElmAff app do

49− unauthedApi <- liftPromise $ services.getApi urls null

50− { masterKey, token, key } <-

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

52− token <-

53− try (Logic.getLogInRequestToken (Email email) (Password password))

54− >>= \et -> case et of

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

56− Right t -> pure t

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

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

59− pure { token, masterKey, key }

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

61− _ <-

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

74+ unauthedApi <- liftPromise $ services.getApi urls jnull

75+ flip runReaderT { api: unauthedApi, crypto: services.crypto, storage:

76+ storage, cryptoFunctions: services.cryptoFunctions } do

77+ {token, prelogin: (prelogin :: PreloginResponse)} <-

78+ try (do

79+ prelogin <- liftPromise $ unauthedApi.postPrelogin {email}

80+ token <- (Logic.getLogInRequestToken prelogin (Email email) (Password password))

81+ pure {token, prelogin}

82+ )

83+ >>= \et -> case et of

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

85+ Right t -> pure t

86+ masterKey <- Logic.makePreloginKey prelogin (Email email) (Password password)

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

6388 sync <- liftPromise $ api.getSync unit

64− processedCiphers <- traverse processCipher sync.ciphers

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

89+ hash <- hashPassword (Password password)

90+ log $ show sync

91+ liftEffect $ Ref.write (Just masterKey) masterKeyRef

92+ liftEffect $ Storage.store storage UrlsKey server

93+ liftEffect $ Storage.store storage MasterPasswordHashKey hash

94+ liftEffect $ Storage.store storage PreloginResponseKey prelogin

95+ liftEffect $ Storage.store storage SyncKey sync

96+ liftEffect $ Storage.store storage TokenKey token

97+ liftEffect $ Elm.send app Bridge.LoginSuccessful

6698 pure unit

6799 pure unit

68− Bridge.Init -> Elm.send app (Bridge.NeedsLogin)

100+ Bridge.NeedCiphersList -> run do

101+ sync <- getOrReset storage SyncKey

102+ ciphers <- traverse processCipher sync.ciphers

103+ liftEffect $ Elm.send app $ Bridge.LoadCiphers $ Bridge.Sub_LoadCiphers_List ciphers

104+ pure unit

105+ Bridge.NeedsReset -> pure unit

106+ Bridge.SendMasterPassword masterPassword -> runElmAff app $ do

107+ flip runReaderT {app: app, storage: storage, crypto: services.crypto, cryptoFunctions: services.cryptoFunctions} $ do

108+ hash <- getOrReset storage MasterPasswordHashKey

109+ newHash <- hashPassword (Password masterPassword)

110+ if hash == newHash

111+ then do

112+ sync <- getOrReset storage SyncKey

113+ prelogin <- getOrReset storage PreloginResponseKey

114+ masterKey <- Logic.makePreloginKey prelogin (Email sync.profile.email) (Password masterPassword)

115+ liftEffect $ Ref.write (Just masterKey) masterKeyRef

116+ liftEffect $ Elm.send app Bridge.LoginSuccessful

117+ else do

118+ liftEffect $ Elm.send app $ Bridge.Error "The password is wrong. Please try again."

119+ requestMasterPassword

120+ pure unit

121+ Bridge.Init -> do

122+ liftEffect $ Storage.get storage TokenKey >>= \x -> case x of

123+ Just _ -> liftEffect $ Elm.send app Bridge.LoginSuccessful

124+ Nothing -> Elm.send app Bridge.NeedsLogin

125+

126+data SyncKey = SyncKey

127+

128+instance StorageKey SyncKey SyncResponse where

129+ storageKey SyncKey = "sync"

130+

131+data TokenKey

132+ = TokenKey

133+

134+instance StorageKey TokenKey IdentityTokenResponse where

135+ storageKey TokenKey = "token"

136+

137+data UrlsKey

138+ = UrlsKey

139+

140+instance StorageKey UrlsKey String where

141+ storageKey UrlsKey = "urls"

142+

143+data PreloginResponseKey

144+ = PreloginResponseKey

145+

146+instance StorageKey PreloginResponseKey PreloginResponse where

147+ storageKey PreloginResponseKey = "prelogin-reponse"

148+

149+data MasterPasswordHashKey

150+ = MasterPasswordHashKey

151+

152+instance StorageKey MasterPasswordHashKey Hash where

153+ storageKey MasterPasswordHashKey = "master-password-hash"

154+

69155

70156processCipher ::

71157 forall r.

@@ -91,14 +177,45 @@ runElmAff app =

91177baseUrl :: String -> Urls

92178baseUrl server =

93179 { base: nullify server

94− , webVault: null

95− , api: null

96− , identity: null

97− , icons: null

98− , notifications: null

99− , events: null

100− , keyConnector: null

180+ , webVault: jnull

181+ , api: jnull

182+ , identity: jnull

183+ , icons: jnull

184+ , notifications: jnull

185+ , events: jnull

186+ , keyConnector: jnull

101187 }

102188

103−nullify :: forall a. a -> Nullable a

104−nullify = Just >>> toNullable

189+getOrReset :: forall k t r. HasL "app" Elm r =>

190+ StorageKey k t => DecodeJson t => Storage -> k -> Al r t

191+getOrReset storage key = do

192+ let handleError = do

193+ app <- l (L :: L "app")

194+ liftEffect $ WebStorage.clear storage

195+ liftEffect $ Elm.send app Bridge.Reset

196+ liftEffect $ Exc.throw "Encountered an internal error. Resetting the app."

197+ try (liftEffect $ Storage.get storage key) >>= \x -> case x of

198+ Left err -> do

199+ liftEffect $ log $ show err

200+ handleError

201+ Right Nothing -> handleError

202+ Right (Just y) -> pure y

203+

204+getAuthedApi :: forall r. HasL "services" Services r => HasL "storage" Storage r

205+ => HasL "app" Elm r =>

206+ Al r ApiService

207+getAuthedApi = do

208+ storage <- l (L :: L "storage")

209+ services <- l (L :: L "services")

210+ token <- getOrReset storage TokenKey

211+ url <- getOrReset storage UrlsKey

212+ liftPromise $ services.getApi (baseUrl url) (nullify token)

213+

214+requestMasterPassword :: forall r. HasL "storage" Storage r => HasL "app" Elm r => Al r Unit

215+requestMasterPassword = do

216+ storage <- l (L :: L "storage")

217+ app <- l (L :: L "app")

218+ url <- getOrReset storage UrlsKey

219+ sync <- getOrReset storage SyncKey

220+ liftEffect $ Elm.send app $ Bridge.NeedsMasterPassword

221+ $ Bridge.Sub_NeedsMasterPassword {server: url, login: sync.profile.email}

bridge.yaml+9

@@ -5,6 +5,12 @@ Sub:

55 List:

66 name: String

77 date: String

8+- LoginSuccessful

9+- NeedsMasterPassword:

10+ server: String

11+ login: String

12+- Reset

13+

814

915Cmd:

1016- Init

@@ -12,3 +18,6 @@ Cmd:

1218 email: String

1319 server: String

1420 password: String

21+- NeedCiphersList

22+- SendMasterPassword: String

23+- NeedsReset

bw/spago.dhalldeleted−20

@@ -1,20 +0,0 @@

1−{ name = "bw"

2−, dependencies =

3− [ "aff"

4− , "aff-promise"

5− , "argonaut"

6− , "argonaut-generic"

7− , "arraybuffer-types"

8− , "console"

9− , "datetime-parsing"

10− , "effect"

11− , "el"

12− , "foreign"

13− , "maybe"

14− , "newtype"

15− , "prelude"

16− , "undefined-is-not-a-problem"

17− ]

18−, packages = ../packages.dhall

19−, sources = [ "src/**/*.purs" ]

20−}

bw/src/BW.pursdeleted−34

@@ -1,34 +0,0 @@

1−module BW where

2−

3−import BW.Types

4−import Prelude

5−import Control.Promise (Promise)

6−import Data.ArrayBuffer.Types (ArrayBuffer)

7−import Data.EncString (EncString)

8−import Data.Function.Uncurried (Fn2, Fn3, Fn4)

9−import Data.Nullable (Nullable)

10−import Data.SymmetricCryptoKey (SymmetricCryptoKey)

11−import Effect (Effect)

12−

13−type CryptoService

14− = { makeKey :: Fn4 Password String KDF Int (Promise SymmetricCryptoKey)

15− , hashPassword :: Fn3 Password SymmetricCryptoKey (Nullable HashPurpose) (Promise Hash)

16− , decryptToUtf8 :: Fn2 EncString SymmetricCryptoKey (Promise String)

17− , decryptToBytes :: Fn2 EncString SymmetricCryptoKey (Promise ArrayBuffer)

18− , stretchKey :: SymmetricCryptoKey -> Promise SymmetricCryptoKey

19− }

20−

21−type ApiService

22− = { postPrelogin :: PreloginRequest -> Promise PreloginResponse

23− , getProfile :: Unit -> Promise ProfileResponse

24− -- TODO: There can really be more request and response types. Maybe handle this later.

25− , postIdentityToken :: PasswordTokenRequest -> Promise IdentityTokenResponse

26− , getSync :: Unit -> Promise SyncResponse

27− }

28−

29−type Services

30− = { crypto :: CryptoService

31− , getApi :: Urls -> Nullable IdentityTokenResponse -> Promise ApiService

32− }

33−

34−foreign import getServices :: Effect Services

bw/src/Data/ShowableJson.pursdeleted−14

@@ -1,14 +0,0 @@

1−module Data.ShowableJson

2− ( ShowableJson(..)

3− )

4− where

5−

6−import Prelude

7−

8−import Data.Argonaut (Json)

9−import Data.Argonaut as Json

10−

11−newtype ShowableJson = ShowableJson Json

12−

13−instance Show ShowableJson where

14− show (ShowableJson x) = Json.stringify x

el/test/Main.purs+10−10

@@ -1,11 +1,9 @@

11module Test.Main

22 ( main

3− )

4− where

3+ ) where

65import Prelude

76import Test.Unit

8−

97import Control.El

108import Control.Monad.Reader (runReaderT)

119import Effect (Effect)

@@ -15,13 +13,15 @@ import Test.Unit.Output.Fancy (runTest)

1513import Type.Proxy (Proxy(..))

1614

1715main ∷ Effect Unit

18−main = launchAff_ $ void $ runTest do

19− suite "sync code" do

20− test "arithmetic" do

21− x <- runReaderT singleHandler {handle: 2, ignore: "Hello"}

22− Assert.equal x 2

23−

16+main =

17+ launchAff_ $ void

18+ $ runTest do

19+ suite "sync code" do

20+ test "arithmetic" do

21+ x <- runReaderT singleHandler { handle: 2, ignored: "Hello" }

22+ Assert.equal x 2

2423

2524singleHandler :: forall r. HasL "handle" Int r => Al r Int

2625singleHandler = do

27− l (L :: L "handle")

26+ x <- l (L :: L "handle")

27+ pure $ x + 1

frontend/Bridge.elm+38

@@ -34,12 +34,18 @@ jsonEncCmd_Login val =

3434type Cmd =

3535 Init

3636 | Login Cmd_Login

37+ | NeedCiphersList

38+ | NeedsReset

39+ | SendMasterPassword String

3740

3841jsonDecCmd : Json.Decode.Decoder ( Cmd )

3942jsonDecCmd =

4043 let jsonDecDictCmd = Dict.fromList

4144 [ ("Init", Json.Decode.lazy (\_ -> Json.Decode.succeed Init))

4245 , ("Login", Json.Decode.lazy (\_ -> Json.Decode.map Login (jsonDecCmd_Login)))

46+ , ("NeedCiphersList", Json.Decode.lazy (\_ -> Json.Decode.succeed NeedCiphersList))

47+ , ("NeedsReset", Json.Decode.lazy (\_ -> Json.Decode.succeed NeedsReset))

48+ , ("SendMasterPassword", Json.Decode.lazy (\_ -> Json.Decode.map SendMasterPassword (Json.Decode.string)))

4349 ]

4450 jsonDecObjectSetCmd = Set.fromList []

4551 in decodeSumTaggedObject "Cmd" "tag" "contents" jsonDecDictCmd jsonDecObjectSetCmd

@@ -49,6 +55,9 @@ jsonEncCmd val =

4955 let keyval v = case v of

5056 Init -> ("Init", encodeValue (Json.Encode.list identity []))

5157 Login v1 -> ("Login", encodeValue (jsonEncCmd_Login v1))

58+ NeedCiphersList -> ("NeedCiphersList", encodeValue (Json.Encode.list identity []))

59+ NeedsReset -> ("NeedsReset", encodeValue (Json.Encode.list identity []))

60+ SendMasterPassword v1 -> ("SendMasterPassword", encodeValue (Json.Encode.string v1))

5261 in encodeSumTaggedObject "tag" "contents" keyval val

5362

5463

@@ -84,17 +93,43 @@ jsonEncSub_LoadCiphers_List val = (Json.Encode.list jsonEncSub_LoadCiphers) val

8493

8594

8695

96+type alias Sub_NeedsMasterPassword =

97+ { login: String

98+ , server: String

99+ }

100+

101+jsonDecSub_NeedsMasterPassword : Json.Decode.Decoder ( Sub_NeedsMasterPassword )

102+jsonDecSub_NeedsMasterPassword =

103+ Json.Decode.succeed (\plogin pserver -> {login = plogin, server = pserver})

104+ |> required "login" (Json.Decode.string)

105+ |> required "server" (Json.Decode.string)

106+

107+jsonEncSub_NeedsMasterPassword : Sub_NeedsMasterPassword -> Value

108+jsonEncSub_NeedsMasterPassword val =

109+ Json.Encode.object

110+ [ ("login", Json.Encode.string val.login)

111+ , ("server", Json.Encode.string val.server)

112+ ]

113+

114+

115+

87116type Sub =

88117 Error String

89118 | LoadCiphers Sub_LoadCiphers_List

119+ | LoginSuccessful

90120 | NeedsLogin

121+ | NeedsMasterPassword Sub_NeedsMasterPassword

122+ | Reset

91123

92124jsonDecSub : Json.Decode.Decoder ( Sub )

93125jsonDecSub =

94126 let jsonDecDictSub = Dict.fromList

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

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

129+ , ("LoginSuccessful", Json.Decode.lazy (\_ -> Json.Decode.succeed LoginSuccessful))

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

131+ , ("NeedsMasterPassword", Json.Decode.lazy (\_ -> Json.Decode.map NeedsMasterPassword (jsonDecSub_NeedsMasterPassword)))

132+ , ("Reset", Json.Decode.lazy (\_ -> Json.Decode.succeed Reset))

98133 ]

99134 jsonDecObjectSetSub = Set.fromList []

100135 in decodeSumTaggedObject "Sub" "tag" "contents" jsonDecDictSub jsonDecObjectSetSub

@@ -104,6 +139,9 @@ jsonEncSub val =

104139 let keyval v = case v of

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

106141 LoadCiphers v1 -> ("LoadCiphers", encodeValue (jsonEncSub_LoadCiphers_List v1))

142+ LoginSuccessful -> ("LoginSuccessful", encodeValue (Json.Encode.list identity []))

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

144+ NeedsMasterPassword v1 -> ("NeedsMasterPassword", encodeValue (jsonEncSub_NeedsMasterPassword v1))

145+ Reset -> ("Reset", encodeValue (Json.Encode.list identity []))

108146 in encodeSumTaggedObject "tag" "contents" keyval val

109147

frontend/Main.elm+73−15

@@ -2,13 +2,14 @@ module Main exposing (..)

33import Bridge

44import Browser

5−import FFI exposing (getBridge)

5+import FFI exposing (getBridge, sendBridge)

66import Html exposing (..)

77import Html.Attributes as Attr

88import Notification

99import Pages.Ciphers as Ciphers

1010import Pages.Loader exposing (loader)

1111import Pages.Login as Login

12+import Pages.MasterPassword as MasterPassword

1213import Pages.Navigation as Navigation

1314import Utils exposing (..)

1415

@@ -22,6 +23,12 @@ type Msg

2223 | LoginMsg Login.Msg

2324 | CiphersMsg Ciphers.Msg

2425 | LoadCiphers Bridge.Sub_LoadCiphers_List

26+ | OpenCiphersScreen

27+ | Reset

28+ | NeedsReset

29+ | MasterPasswordMsg MasterPassword.Msg

30+ | SendMasterPassword { password : String }

31+ | ShowMasterPasswordPage { server : String, login : String }

2532

2633

2734type alias Model =

@@ -39,6 +46,7 @@ type PageModel

3946 = LoginModel Login.Model

4047 | LoadingPage

4148 | CiphersModel Ciphers.Model

49+ | MasterPasswordModel MasterPassword.Model

4250

4351

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

@@ -61,6 +69,13 @@ showPage page =

6169 LoadingPage ->

6270 ( "", [ loader ] )

6371

72+ MasterPasswordModel model ->

73+ let

74+ p =

75+ MasterPassword.page masterPasswordCallbacks MasterPasswordMsg

76+ in

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

78+

6479

6580main : Program () Model Msg

6681main =

@@ -68,23 +83,35 @@ main =

6883 { init = \_ -> init

6984 , view = view

7085 , update = update

71− , subscriptions =

72− \_ ->

73− getBridge ShowError

74− (\msg ->

75− case msg of

76− Bridge.NeedsLogin ->

77− ShowLoginPage

78−

79− Bridge.Error err ->

80− ShowError err

81−

82− Bridge.LoadCiphers ciphers ->

83− LoadCiphers ciphers

84− )

86+ , subscriptions = subscriptions

8587 }

8688

8789

90+subscriptions : Model -> Sub Msg

91+subscriptions _ =

92+ getBridge ShowError

93+ (\msg ->

94+ case msg of

95+ Bridge.NeedsLogin ->

96+ ShowLoginPage

97+

98+ Bridge.Error err ->

99+ ShowError err

100+

101+ Bridge.LoadCiphers ciphers ->

102+ LoadCiphers ciphers

103+

104+ Bridge.LoginSuccessful ->

105+ OpenCiphersScreen

106+

107+ Bridge.Reset ->

108+ Reset

109+

110+ Bridge.NeedsMasterPassword { server, login } ->

111+ ShowMasterPasswordPage { server = server, login = login }

112+ )

113+

114+

88115init : ( Model, Cmd Msg )

89116init =

90117 ( { notifications = []

@@ -181,6 +208,30 @@ update msg model =

181208 (Ciphers.page ciphersCallbacks CiphersMsg).init ciphers

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

183210

211+ OpenCiphersScreen ->

212+ ( { model | page = LoadingPage }, sendBridge Bridge.NeedCiphersList )

213+

214+ Reset ->

215+ init

216+

217+ ShowMasterPasswordPage { server, login } ->

218+ (MasterPassword.page masterPasswordCallbacks MasterPasswordMsg).init { server = server, login = login }

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

220+

221+ NeedsReset ->

222+ ( { model | page = LoadingPage }, sendBridge Bridge.NeedsReset )

223+

224+ SendMasterPassword { password } ->

225+ ( { model | page = LoadingPage }, sendBridge (Bridge.SendMasterPassword password) )

226+

227+ MasterPasswordMsg imsg ->

228+ case model.page of

229+ MasterPasswordModel page ->

230+ (MasterPassword.page masterPasswordCallbacks MasterPasswordMsg).update imsg page |> processPage MasterPasswordModel

231+

232+ _ ->

233+ ( model, Cmd.none )

234+

184235

185236loginCallbacks : Login.Callbacks Msg

186237loginCallbacks =

@@ -190,3 +241,10 @@ loginCallbacks =

190241ciphersCallbacks : Ciphers.Callbacks

191242ciphersCallbacks =

192243 {}

244+

245+

246+masterPasswordCallbacks : MasterPassword.Callbacks Msg

247+masterPasswordCallbacks =

248+ { submit = SendMasterPassword

249+ , reset = NeedsReset

250+ }

frontend/Pages/MasterPassword.elmnew file+85

@@ -0,0 +1,85 @@

1+module Pages.MasterPassword exposing (..)

3+import Html exposing (..)

4+import Html.Attributes as Attr

5+import Html.Events as Ev

6+import Page exposing (..)

7+import Utils exposing (..)

10+type alias Model =

11+ { server : String

12+ , email : String

13+ , password : String

14+ }

15+

16+

17+type Msg

18+ = UpdatePassword String

19+ | Submit

20+ | Reset

21+

22+

23+type alias Callbacks emsg =

24+ { submit : { password : String } -> emsg

25+ , reset : emsg

26+ }

27+

28+

29+page : Callbacks emsg -> Page { server : String, login : String } Model Msg emsg

30+page callbacks liftMsg =

31+ { init = \cfg -> Tuple.mapSecond (Cmd.map liftMsg) (init cfg)

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

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

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

35+ , title = always "Enter master password"

36+ }

37+

38+

39+init : { server : String, login : String } -> ( Model, Cmd Msg )

40+init { server, login } =

41+ ( { server = server

42+ , email = login

43+ , password = ""

44+ }

45+ , Cmd.none

46+ )

47+

48+

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

50+update { submit, reset } _ msg model =

51+ case msg of

52+ UpdatePassword password ->

53+ ( Ok { model | password = password }, Cmd.none )

54+

55+ Submit ->

56+ ( Ok model, pureCmd (submit { password = model.password }) )

57+

58+ Reset ->

59+ ( Ok model, pureCmd reset )

60+

61+

62+subscriptions : Model -> Sub Msg

63+subscriptions _ =

64+ Sub.none

65+

66+

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

68+view model =

69+ [ alignRight [ button [ Attr.class "p-button--negative" ] [ text "Log out" ] ]

70+ , table [ Attr.class "p-table--mobile-card" ]

71+ [ thead [] [ tr [] [ th [] [ text "Server" ], th [] [ text "Email" ] ] ]

72+ , tbody

73+ []

74+ [ tr []

75+ [ td [ Attr.attribute "data-heading" "Server" ] [ text model.server ]

76+ , td [ Attr.attribute "data-heading" "Email" ] [ text model.email ]

77+ ]

78+ ]

79+ ]

80+ , form []

81+ [ label [] [ text "Password" ]

82+ , input [ Attr.type_ "password", Attr.value model.password, Ev.onInput UpdatePassword ] []

83+ ]

84+ , alignRight [ button [ Ev.onClick Submit ] [ text "Log in" ] ]

85+ ]

packages.dhall+20−1

@@ -103,7 +103,6 @@ let upstream =

103103 sha256:7a24ebdbacb2bfa27b2fc6ce3da96f048093d64e54369965a2a7b5d9892b6031

104104

105105in upstream

106− with bw = ./bw/spago.dhall as Location

107106 with el = ./el/spago.dhall as Location

108107 with argonaut-aeson-generic =

109108 { dependencies =

@@ -129,3 +128,23 @@ in upstream

129128 "https://github.com/ilyakooo0/purescript-argonaut-aeson-generic.git"

130129 , version = "purescript-0.14"

131130 }

131+ with subtlecrypto =

132+ { dependencies =

133+ [ "aff"

134+ , "aff-promise"

135+ , "arraybuffer-types"

136+ , "console"

137+ , "effect"

138+ , "either"

139+ , "exceptions"

140+ , "foreign"

141+ , "functions"

142+ , "maybe"

143+ , "prelude"

144+ , "transformers"

145+ , "tuples"

146+ , "unsafe-coerce"

147+ ]

148+ , repo = "https://github.com/xc-jp/purescript-subtlecrypto.git"

149+ , version = "7999dc92b94d1b7285375cfaad4a0ae6644b71b6"

150+ }

spago.dhall+11−1

@@ -17,8 +17,10 @@ to generate this file without the comments in this block.

1717 , "argonaut"

1818 , "argonaut-aeson-generic"

1919 , "argonaut-codecs"

20+ , "arraybuffer"

21+ , "arraybuffer-types"

2022 , "arrays"

21− , "bw"

23+ , "bifunctors"

2224 , "console"

2325 , "datetime"

2426 , "datetime-parsing"

@@ -28,13 +30,21 @@ to generate this file without the comments in this block.

2830 , "exceptions"

2931 , "foldable-traversable"

3032 , "foreign"

33+ , "functions"

3134 , "lists"

3235 , "maybe"

3336 , "newtype"

3437 , "nullable"

3538 , "prelude"

39+ , "refs"

40+ , "strings"

41+ , "subtlecrypto"

3642 , "transformers"

43+ , "typelevel-prelude"

44+ , "undefined-is-not-a-problem"

3745 , "unsafe-coerce"

46+ , "web-html"

47+ , "web-storage"

3848 ]

3949, packages = ./packages.dhall

4050, sources = [ "backend/**/*.purs" ]