@@ -3,12 +3,11 @@ module Main
33 ) where
44
55import Prelude
6−
7−import BW (ApiService, CryptoService, Hash, Services)
6+import BW (ApiService, CryptoService, Services)
87import BW as WB
9−import BW.Logic (decrypt, hashPassword, liftPromise)
8+import BW.Logic (decodeCipher, decrypt, hashPassword, liftPromise)
109import BW.Logic as Logic
11−import BW.Types (CipherResponse, Email(..), IdentityTokenResponse, Password(..), PreloginResponse, SyncResponse, Urls, cipherTypeCard, cipherTypeIdentity, cipherTypeLogin, cipherTypeSecureNote)
10+import BW.Types (CipherResponse, Email(..), Password(..), PreloginResponse, Urls, cipherTypeCard, cipherTypeIdentity, cipherTypeLogin, cipherTypeSecureNote)
1211import Bridge as Bridge
1312import Control.El (class HasL, Al, L(..), l)
1413import Control.Monad.Error.Class (throwError)
@@ -19,11 +18,8 @@ import Data.Clipboard as Clipboard
1918import Data.DateTime (DateTime)
2019import Data.Either (Either(..))
2120import Data.HCaptcha (bindHCaptchToken)
22−import Data.JNullable (fromJNullable, jnull, nullify)
23−import Data.JNullable as JNullable
24−import Data.JOpt (fromJOpt)
21+import Data.JNullable (jnull, nullify)
2522import Data.Maybe (Maybe(..))
26−import Data.Newtype (wrap)
2723import Data.OpenURL (openURL)
2824import Data.Ord.Down (Down(..))
2925import Data.SymmetricCryptoKey (SymmetricCryptoKey)
@@ -41,6 +37,7 @@ import FFI (Elm)
4137import FFI as FFI
4238import Localstorage (class StorageKey)
4339import Localstorage as Storage
40+import Storage (MasterPasswordHashKey(..), PreloginResponseKey(..), SyncKey(..), TokenKey(..), UrlsKey(..))
4441import Web.HTML as Html
4542import Web.HTML.Window as Window
4643import Web.Storage.Storage (Storage)
@@ -53,218 +50,141 @@ main = do
5350 services <- WB.getServices
5451 masterKeyRef <- Ref.new Nothing
5552 bindHCaptchToken log
56− let run act = do
57− maybeKey <- Ref.read masterKeyRef
58− runElmAff app $ flip runReaderT {app: app, crypto : services.crypto, storage: storage} $
59− case maybeKey of
60− Just masterKey -> do
61− token <- getOrReset storage TokenKey
62− key <- Logic.makeDecryptionKey masterKey token.key
63− liftEffect $ runElmAff app $ runReaderT act
64− {app : app , storage : storage, services : services, crypto : services.crypto
65− , key : key}
66− Nothing -> requestMasterPassword
53+ let
54+ run act = do
55+ maybeKey <- Ref.read masterKeyRef
56+ runElmAff app $ flip runReaderT { app: app, crypto: services.crypto, storage: storage }
57+ $ case maybeKey of
58+ Just masterKey -> do
59+ token <- getOrReset storage TokenKey
60+ key <- Logic.makeDecryptionKey masterKey token.key
61+ liftEffect $ runElmAff app
62+ $ runReaderT act
63+ { app: app
64+ , storage: storage
65+ , services: services
66+ , crypto: services.crypto
67+ , key: key
68+ }
69+ Nothing -> requestMasterPassword
6770 Elm.subscribe app \cmd -> case cmd of
6871 Bridge.Login (Bridge.Cmd_Login { email, server, password }) -> do
6972 let
7073 urls = baseUrl server
7174 runElmAff app do
7275 unauthedApi <- liftPromise $ services.getApi urls jnull
73− flip runReaderT { api: unauthedApi, crypto: services.crypto, storage:
74− storage, cryptoFunctions: services.cryptoFunctions } do
75− {token, prelogin: (prelogin :: PreloginResponse)} <-
76− try (do
77− prelogin <- liftPromise $ unauthedApi.postPrelogin {email}
78− token <- (Logic.getLogInRequestToken prelogin (Email email) (Password password))
79− pure {token, prelogin}
80− )
81− >>= \et -> case et of
82− Left _ -> liftEffect $ Exc.throw "Could not log in. Please check your data and try again."
83− Right t -> pure t
84− masterKey <- Logic.makePreloginKey prelogin (Email email) (Password password)
85− api <- liftPromise $ services.getApi urls (nullify token)
86− sync <- liftPromise $ api.getSync unit
87− hash <- hashPassword (Password password)
88− log $ show sync
89− liftEffect $ Ref.write (Just masterKey) masterKeyRef
90− liftEffect $ Storage.store storage UrlsKey server
91− liftEffect $ Storage.store storage MasterPasswordHashKey hash
92− liftEffect $ Storage.store storage PreloginResponseKey prelogin
93− liftEffect $ Storage.store storage SyncKey sync
94− liftEffect $ Storage.store storage TokenKey token
95− liftEffect $ Elm.send app Bridge.LoginSuccessful
96− pure unit
76+ flip runReaderT
77+ { api: unauthedApi
78+ , crypto: services.crypto
79+ , storage:
80+ storage
81+ , cryptoFunctions: services.cryptoFunctions
82+ } do
83+ { token, prelogin: (prelogin :: PreloginResponse) } <-
84+ try
85+ ( do
86+ prelogin <- liftPromise $ unauthedApi.postPrelogin { email }
87+ token <- (Logic.getLogInRequestToken prelogin (Email email) (Password password))
88+ pure { token, prelogin }
89+ )
90+ >>= \et -> case et of
91+ Left _ -> liftEffect $ Exc.throw "Could not log in. Please check your data and try again."
92+ Right t -> pure t
93+ masterKey <- Logic.makePreloginKey prelogin (Email email) (Password password)
94+ api <- liftPromise $ services.getApi urls (nullify token)
95+ sync <- liftPromise $ api.getSync unit
96+ hash <- hashPassword (Password password)
97+ log $ show sync
98+ liftEffect $ Ref.write (Just masterKey) masterKeyRef
99+ liftEffect $ Storage.store storage UrlsKey server
100+ liftEffect $ Storage.store storage MasterPasswordHashKey hash
101+ liftEffect $ Storage.store storage PreloginResponseKey prelogin
102+ liftEffect $ Storage.store storage SyncKey sync
103+ liftEffect $ Storage.store storage TokenKey token
104+ liftEffect $ Elm.send app Bridge.LoginSuccessful
105+ pure unit
106+ pure unit
107+ Bridge.NeedCiphersList ->
108+ run do
109+ sync <- getOrReset storage SyncKey
110+ ciphers <- traverse processCipher sync.ciphers
111+ let
112+ sortedCiphers = Array.sortWith (_.date >>> Down) ciphers
113+ liftEffect $ Elm.send app $ Bridge.LoadCiphers $ Bridge.Sub_LoadCiphers_List $ map _.cipher sortedCiphers
114+ liftEffect $ Storage.store storage SyncKey sync
97115 pure unit
98− Bridge.NeedCiphersList -> run do
99− sync <- getOrReset storage SyncKey
100− ciphers <- traverse processCipher sync.ciphers
101− let sortedCiphers = Array.sortWith (_.date >>> Down) ciphers
102− liftEffect $ Elm.send app $ Bridge.LoadCiphers $ Bridge.Sub_LoadCiphers_List $ map _.cipher sortedCiphers
103− liftEffect $ Storage.store storage SyncKey sync
104− pure unit
105116 Bridge.NeedsReset -> do
106117 WebStorage.clear storage
107118 Elm.send app Bridge.Reset
108119 pure unit
109− Bridge.SendMasterPassword masterPassword -> runElmAff app $ do
110− flip runReaderT {app: app, storage: storage, crypto: services.crypto, cryptoFunctions: services.cryptoFunctions} $ do
111− hash <- getOrReset storage MasterPasswordHashKey
112− newHash <- hashPassword (Password masterPassword)
113− if hash == newHash
114− then do
115− sync <- getOrReset storage SyncKey
116− prelogin <- getOrReset storage PreloginResponseKey
117− masterKey <- Logic.makePreloginKey prelogin (Email sync.profile.email) (Password masterPassword)
118− liftEffect $ Ref.write (Just masterKey) masterKeyRef
119− liftEffect $ Elm.send app Bridge.LoginSuccessful
120− else do
121− liftEffect $ Elm.send app $ Bridge.Error "The password is wrong. Please try again."
122− requestMasterPassword
123− pure unit
120+ Bridge.SendMasterPassword masterPassword ->
121+ runElmAff app
122+ $ do
123+ flip runReaderT { app: app, storage: storage, crypto: services.crypto, cryptoFunctions: services.cryptoFunctions }
124+ $ do
125+ hash <- getOrReset storage MasterPasswordHashKey
126+ newHash <- hashPassword (Password masterPassword)
127+ if hash == newHash then do
128+ sync <- getOrReset storage SyncKey
129+ prelogin <- getOrReset storage PreloginResponseKey
130+ masterKey <- Logic.makePreloginKey prelogin (Email sync.profile.email) (Password masterPassword)
131+ liftEffect $ Ref.write (Just masterKey) masterKeyRef
132+ liftEffect $ Elm.send app Bridge.LoginSuccessful
133+ else do
134+ liftEffect $ Elm.send app $ Bridge.Error "The password is wrong. Please try again."
135+ requestMasterPassword
136+ pure unit
124137 Bridge.Init -> do
125− liftEffect $ Storage.get storage TokenKey >>= \x -> case x of
126− Just _ -> do liftEffect $ Elm.send app Bridge.LoginSuccessful
127− Nothing -> Elm.send app Bridge.NeedsLogin
128− Bridge.RequestCipher id -> run do
129− sync <- getOrReset storage SyncKey
130− case Array.find (\c -> c.id == id) sync.ciphers of
131− Nothing -> pure unit
132− Just cipher -> do
133− name <- decrypt cipher.name
134− cipherType <- do
135− case cipher.type of
136− n | cipherTypeSecureNote == n -> do
137− note <- fromJNullable "" <$> (traverse decrypt cipher.notes)
138− pure $ Bridge.NoteCipher note
139− n | cipherTypeLogin == n -> do
140− case JNullable.toMaybe cipher.login of
141− Nothing -> throwError $ error "Login data is missing"
142− Just login -> do
143− username <- wrap <<< fromJNullable Nothing <<< map Just <$> (traverse decrypt login.username)
144− password <- wrap <<< fromJNullable Nothing <<< map Just <$> (traverse decrypt login.password)
145− uris <- fromJOpt [] <$> ((traverse >>> traverse) (_.uri >>> decrypt) login.uris)
146− pure $ Bridge.LoginCipher $ Bridge.Cipher_LoginCipher
147− { username
148− , password
149− , uris: wrap uris
150− }
151− n | cipherTypeCard == n -> do
152− case JNullable.toMaybe cipher.card of
153− Nothing -> throwError $ error "Card data is missing"
154− Just card -> do
155− cardholderName <- wrap <<< fromJNullable Nothing <<< map Just <$> (traverse decrypt card.cardholderName)
156− number <- wrap <<< fromJNullable Nothing <<< map Just <$> (traverse decrypt card.number)
157− code <- wrap <<< fromJNullable Nothing <<< map Just <$> (traverse decrypt card.code)
158− brand <- wrap <<< fromJNullable Nothing <<< map Just <$> (traverse decrypt card.brand)
159− expMonth <- wrap <<< fromJNullable Nothing <<< map Just <$> (traverse decrypt card.expMonth)
160− expYear <- wrap <<< fromJNullable Nothing <<< map Just <$> (traverse decrypt card.expYear)
161− pure $ Bridge.CardCipher $ Bridge.Cipher_CardCipher
162− { brand, cardholderName, code, expMonth, expYear, number }
163− n | cipherTypeIdentity == n -> do
164− case JNullable.toMaybe cipher.identity of
165− Nothing -> throwError $ error "Identity data is missing"
166− Just identity -> do
167− firstName <- wrap <<< fromJNullable Nothing <<< map Just <$> (traverse decrypt identity.firstName)
168− middleName <- wrap <<< fromJNullable Nothing <<< map Just <$> (traverse decrypt identity.middleName)
169− lastName <- wrap <<< fromJNullable Nothing <<< map Just <$> (traverse decrypt identity.lastName)
170− address1 <- wrap <<< fromJNullable Nothing <<< map Just <$> (traverse decrypt identity.address1)
171− address2 <- wrap <<< fromJNullable Nothing <<< map Just <$> (traverse decrypt identity.address2)
172− address3 <- wrap <<< fromJNullable Nothing <<< map Just <$> (traverse decrypt identity.address3)
173− city <- wrap <<< fromJNullable Nothing <<< map Just <$> (traverse decrypt identity.city)
174− company <- wrap <<< fromJNullable Nothing <<< map Just <$> (traverse decrypt identity.company)
175− country <- wrap <<< fromJNullable Nothing <<< map Just <$> (traverse decrypt identity.country)
176− email <- wrap <<< fromJNullable Nothing <<< map Just <$> (traverse decrypt identity.email)
177− licenseNumber <- wrap <<< fromJNullable Nothing <<< map Just <$> (traverse decrypt identity.licenseNumber)
178− passportNumber <- wrap <<< fromJNullable Nothing <<< map Just <$> (traverse decrypt identity.passportNumber)
179− phone <- wrap <<< fromJNullable Nothing <<< map Just <$> (traverse decrypt identity.phone)
180− postalCode <- wrap <<< fromJNullable Nothing <<< map Just <$> (traverse decrypt identity.postalCode)
181− ssn <- wrap <<< fromJNullable Nothing <<< map Just <$> (traverse decrypt identity.ssn)
182− state <- wrap <<< fromJNullable Nothing <<< map Just <$> (traverse decrypt identity.state)
183− title <- wrap <<< fromJNullable Nothing <<< map Just <$> (traverse decrypt identity.title)
184− username <- wrap <<< fromJNullable Nothing <<< map Just <$> (traverse decrypt identity.username)
185− pure $ Bridge.IdentityCipher $ wrap
186− { firstName,
187− middleName,
188− lastName,
189− address1,
190− address2,
191− address3,
192− city,
193− company,
194− country,
195− email,
196− licenseNumber,
197− passportNumber,
198− phone,
199− postalCode,
200− ssn,
201− state,
202− title,
203− username
204− }
205− n -> throwError $ error $ "Unsupported cipher type: " <> show n
206− send $ Bridge.LoadCipher $ Bridge.Sub_LoadCipher {cipherType, name, id}
207− pure unit
208− pure unit
209− Bridge.NeedEmail -> run do
210− sync <- getOrReset storage SyncKey
211− send $ Bridge.RecieveEmail sync.profile.email
212− pure unit
213− Bridge.Copy text -> run do
214− liftPromise $ Clipboard.clipboard text
138+ liftEffect $ Storage.get storage TokenKey
139+ >>= \x -> case x of
140+ Just _ -> do liftEffect $ Elm.send app Bridge.LoginSuccessful
141+ Nothing -> Elm.send app Bridge.NeedsLogin
142+ Bridge.RequestCipher id ->
143+ run do
144+ sync <- getOrReset storage SyncKey
145+ case Array.find (\c -> c.id == id) sync.ciphers of
146+ Nothing -> pure unit
147+ Just cipherResponse -> do
148+ cipher <- decodeCipher cipherResponse
149+ send $ Bridge.LoadCipher cipher
150+ pure unit
151+ pure unit
152+ Bridge.NeedEmail ->
153+ run do
154+ sync <- getOrReset storage SyncKey
155+ send $ Bridge.RecieveEmail sync.profile.email
156+ pure unit
157+ Bridge.Copy text ->
158+ run do
159+ liftPromise $ Clipboard.clipboard text
215160 Bridge.Open uri -> openURL uri
216161
217−data SyncKey = SyncKey
218−
219−instance StorageKey SyncKey SyncResponse where
220− storageKey SyncKey = "sync"
221−
222−data TokenKey
223− = TokenKey
224−
225−instance StorageKey TokenKey IdentityTokenResponse where
226− storageKey TokenKey = "token"
227−
228−data UrlsKey
229− = UrlsKey
230−
231−instance StorageKey UrlsKey String where
232− storageKey UrlsKey = "urls"
233−
234−data PreloginResponseKey
235− = PreloginResponseKey
236−
237−instance StorageKey PreloginResponseKey PreloginResponse where
238− storageKey PreloginResponseKey = "prelogin-reponse"
239−
240−data MasterPasswordHashKey
241− = MasterPasswordHashKey
242−
243−instance StorageKey MasterPasswordHashKey Hash where
244− storageKey MasterPasswordHashKey = "master-password-hash"
245−
246−
247162processCipher ::
248163 forall r.
249164 HasL "crypto" CryptoService r =>
250165 HasL "key" SymmetricCryptoKey r =>
251− CipherResponse -> Al r {cipher :: Bridge.Sub_LoadCiphers, date :: DateTime}
166+ CipherResponse -> Al r { cipher :: Bridge.Sub_LoadCiphers, date :: DateTime }
252167processCipher cipher = do
253168 name <- decrypt cipher.name
254169 cipherType <- case cipher.type of
255− n | n == cipherTypeLogin -> pure Bridge.LoginType
256− n | n == cipherTypeSecureNote -> pure Bridge.NoteType
257− n | n == cipherTypeCard -> pure Bridge.CardType
258− n | n == cipherTypeIdentity -> pure Bridge.IdentityType
259− n -> throwError $ error $ "Unsupported cipher type: " <> show n
170+ n
171+ | n == cipherTypeLogin -> pure Bridge.LoginType
172+ n
173+ | n == cipherTypeSecureNote -> pure Bridge.NoteType
174+ n
175+ | n == cipherTypeCard -> pure Bridge.CardType
176+ n
177+ | n == cipherTypeIdentity -> pure Bridge.IdentityType
178+ n -> throwError $ error $ "Unsupported cipher type: " <> show n
260179 date <- liftEffect $ Timestamp.toDateTime cipher.revisionDate
261180 pure
262− $ {cipher: Bridge.Sub_LoadCiphers
263− { name: name
264− , date: Timestamp.toLocalDateTimeString cipher.revisionDate
265− , id: cipher.id
266− , cipherType
267− }
181+ $ { cipher:
182+ Bridge.Sub_LoadCiphers
183+ { name: name
184+ , date: Timestamp.toLocalDateTimeString cipher.revisionDate
185+ , id: cipher.id
186+ , cipherType
187+ }
268188 , date
269189 }
270190
@@ -290,23 +210,30 @@ baseUrl server =
290210 , keyConnector: jnull
291211 }
292212
293−getOrReset :: forall k t r. HasL "app" Elm r =>
213+getOrReset ::
214+ forall k t r.
215+ HasL "app" Elm r =>
294216 StorageKey k t => DecodeJson t => Storage -> k -> Al r t
295217getOrReset storage key = do
296− let handleError = do
297− app <- l (L :: L "app")
298− liftEffect $ WebStorage.clear storage
299− liftEffect $ Elm.send app Bridge.Reset
300− liftEffect $ Exc.throw "Encountered an internal error. Resetting the app."
301− try (liftEffect $ Storage.get storage key) >>= \x -> case x of
302− Left err -> do
303− liftEffect $ log $ show err
304− handleError
305− Right Nothing -> handleError
306− Right (Just y) -> pure y
218+ let
219+ handleError = do
220+ app <- l (L :: L "app")
221+ liftEffect $ WebStorage.clear storage
222+ liftEffect $ Elm.send app Bridge.Reset
223+ liftEffect $ Exc.throw "Encountered an internal error. Resetting the app."
224+ try (liftEffect $ Storage.get storage key)
225+ >>= \x -> case x of
226+ Left err -> do
227+ liftEffect $ log $ show err
228+ handleError
229+ Right Nothing -> handleError
230+ Right (Just y) -> pure y
307231
308−getAuthedApi :: forall r. HasL "services" Services r => HasL "storage" Storage r
309− => HasL "app" Elm r =>
232+getAuthedApi ::
233+ forall r.
234+ HasL "services" Services r =>
235+ HasL "storage" Storage r =>
236+ HasL "app" Elm r =>
310237 Al r ApiService
311238getAuthedApi = do
312239 storage <- l (L :: L "storage")
@@ -322,7 +249,7 @@ requestMasterPassword = do
322249 url <- getOrReset storage UrlsKey
323250 sync <- getOrReset storage SyncKey
324251 liftEffect $ Elm.send app $ Bridge.NeedsMasterPassword
325− $ Bridge.Sub_NeedsMasterPassword {server: url, login: sync.profile.email}
252+ $ Bridge.Sub_NeedsMasterPassword { server: url, login: sync.profile.email }
326253
327254send :: forall r. HasL "app" Elm r => Bridge.Sub -> Al r Unit
328255send sub = do