79d2af4 · warden · git.iko.soy

git.iko.soy/warden

on master help sign in

Switched from Al to Run

79d2af4iko4 years ago

backend/BW/Logic.purs+84−32

compare with master

unifiedsplit

@@ -2,7 +2,6 @@ module BW.Logic where

3import BW

4import BW.Types

5−import Control.El

6import Prelude

5import Prelude

7import Bridge as Bridge

6import Bridge as Bridge

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

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

@@ -13,38 +12,57 @@ import Data.Function.Uncurried (runFn2, runFn3, runFn4)

13import Data.JNullable (JNullable, fromJNullable, jnull, nullify)

12import Data.JNullable (JNullable, fromJNullable, jnull, nullify)

14import Data.JNullable as JNullable

13import Data.JNullable as JNullable

15import Data.JOpt (fromJOpt)

14import Data.JOpt (fromJOpt)

16−import Data.Maybe (Maybe(..))

15+import Data.Maybe (Maybe(..), fromMaybe)

17import Data.Newtype (class Newtype, wrap)

16import Data.Newtype (class Newtype, wrap)

18−import Data.JNullable (jnull, nullify)

19−import Data.Maybe (Maybe, fromMaybe)

20import Data.String as String

17import Data.String as String

21import Data.SymmetricCryptoKey (SymmetricCryptoKey)

18import Data.SymmetricCryptoKey (SymmetricCryptoKey)

22import Data.SymmetricCryptoKey as SymmetricCryptoKey

19import Data.SymmetricCryptoKey as SymmetricCryptoKey

23import Data.Traversable (traverse)

20import Data.Traversable (traverse)

21+import Effect (Effect)

22+import Effect.Aff (Aff)

24import Effect.Aff.Class (class MonadAff, liftAff)

23import Effect.Aff.Class (class MonadAff, liftAff)

25import Effect.Class (liftEffect)

24import Effect.Class (liftEffect)

26import Effect.Exception (error)

25import Effect.Exception (error)

27import Effect.Exception as Exc

26import Effect.Exception as Exc

27+import Run (Run)

28+import Run.Reader (Reader, askAt)

29+import Type.Prelude (Proxy(..))

28import Untagged.Union (type (|+|))

30import Untagged.Union (type (|+|))

30-- | Creates the master key

32-- | Creates the master key

31makePreloginKey ::

33makePreloginKey ::

32 forall r.

34 forall r.

33− HasL "crypto" CryptoService r =>

35+ PreloginResponse ->

36+ Email ->

37+ Password ->

38+ Run

39+ ( crypto ::

40+ Reader CryptoService

41+ , effect :: Effect

42+ , aff :: Aff

43+ | r

44+ )

34− PreloginResponse -> Email -> Password -> Al r SymmetricCryptoKey

45+ SymmetricCryptoKey

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

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

36− crypto <- l (L :: L "crypto")

47+ crypto <- askAt (Proxy :: _ "crypto")

37 let

48 let

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

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

39 liftPromise $ runFn4 crypto.makeKey password email kdf kdfIterations

50 liftPromise $ runFn4 crypto.makeKey password email kdf kdfIterations

41makeDecryptionKey ::

52makeDecryptionKey ::

42 forall r.

53 forall r.

43− HasL "crypto" CryptoService r =>

44 -- | Matser key (prelogin key)

54 -- | Matser key (prelogin key)

45− SymmetricCryptoKey -> EncryptedString -> Al r SymmetricCryptoKey

55+ SymmetricCryptoKey ->

56+ EncryptedString ->

57+ Run

58+ ( crypto :: Reader CryptoService

59+ , effect :: Effect

60+ , aff :: Aff

61+ | r

62+ )

63+ SymmetricCryptoKey

46makeDecryptionKey masterKey str = do

64makeDecryptionKey masterKey str = do

47− crypto <- l (L :: L "crypto")

65+ crypto <- askAt (Proxy :: _ "crypto")

48 let

66 let

49 encryptedKeyString = EncString.fromString str

67 encryptedKeyString = EncString.fromString str

@@ -61,13 +79,22 @@ makeDecryptionKey masterKey str = do

62getLogInRequestToken ::

80getLogInRequestToken ::

63 forall r.

81 forall r.

64− HasL "api" ApiService r =>

82+ PreloginResponse ->

65− HasL "crypto" CryptoService r =>

83+ Email ->

84+ Password ->

85+ Maybe String ->

86+ Run

87+ ( api :: Reader ApiService

88+ , crypto :: Reader CryptoService

89+ , effect :: Effect

90+ , aff :: Aff

91+ | r

92+ )

66− PreloginResponse -> Email -> Password -> Maybe String -> Al r (IdentityCaptchaResponse |+| IdentityTokenResponse)

93+ (IdentityCaptchaResponse |+| IdentityTokenResponse)

67getLogInRequestToken prelogin email password captchaResponse = do

94getLogInRequestToken prelogin email password captchaResponse = do

68 key <- makePreloginKey prelogin email password

95 key <- makePreloginKey prelogin email password

69− crypto <- l (L :: L "crypto")

96+ crypto <- askAt (Proxy :: _ "crypto")

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

97+ api :: ApiService <- askAt (Proxy :: _ "api")

71 _localHashedPassword <-

98 _localHashedPassword <-

72 liftPromise

99 liftPromise

73 $ runFn3 crypto.hashPassword password key (nullify hashPurposeLocalAuthorization)

100 $ runFn3 crypto.hashPassword password key (nullify hashPurposeLocalAuthorization)

@@ -90,20 +117,34 @@ getLogInRequestToken prelogin email password captchaResponse = do

90 }

117 }

91 }

118 }

119

93−hashPassword :: forall r. HasL "cryptoFunctions" CryptoFunctions r => Password -> Al r Hash

120+hashPassword ::

121+ forall r.

122+ Password ->

123+ Run

124+ ( cryptoFunctions :: Reader CryptoFunctions

125+ , aff :: Aff

126+ , effect :: Effect

127+ | r

128+ )

129+ Hash

94hashPassword (Password password) = do

130hashPassword (Password password) = do

95− cryptoFunctions <- l (L :: L "cryptoFunctions")

131+ cryptoFunctions <- askAt (Proxy :: _ "cryptoFunctions")

96 liftPromise $ runFn2 cryptoFunctions.hash password cryptoFunctionsTypeSha512

132 liftPromise $ runFn2 cryptoFunctions.hash password cryptoFunctionsTypeSha512

133

98decrypt ::

134decrypt ::

99 forall r.

135 forall r.

100− HasL "crypto" CryptoService r =>

101− HasL "key" SymmetricCryptoKey r =>

102 EncryptedString ->

136 EncryptedString ->

137+ Run

138+ ( key :: Reader SymmetricCryptoKey

139+ , crypto :: Reader CryptoService

140+ , aff :: Aff

141+ , effect :: Effect

142+ | r

143+ )

103− Al r String

144+ String

104decrypt input = do

145decrypt input = do

105− crypto <- l (L :: L "crypto")

146+ crypto <- askAt (Proxy :: _ "crypto")

106− key <- l (L :: L "key")

147+ key <- askAt (Proxy :: _ "key")

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

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

108

149

109liftPromise ∷ forall m a. MonadAff m ⇒ Promise a → m a

150liftPromise ∷ forall m a. MonadAff m ⇒ Promise a → m a

@@ -111,9 +152,15 @@ liftPromise = liftAff <<< Promise.toAff

111

152

112decodeCipher ::

153decodeCipher ::

113 forall r.

154 forall r.

155+ CipherResponse ->

156+ Run

157+ ( key :: Reader SymmetricCryptoKey

114− HasL "crypto" CryptoService r =>

158+ , crypto :: Reader CryptoService

115− HasL "key" SymmetricCryptoKey r =>

159+ , aff :: Aff

160+ , effect :: Effect

161+ | r

162+ )

116− CipherResponse -> Al r Bridge.Sub_LoadCipher

163+ Bridge.Sub_LoadCipher

117decodeCipher cipher = do

164decodeCipher cipher = do

118 name <- decrypt cipher.name

165 name <- decrypt cipher.name

119 cipherType <- case cipher.type of

166 cipherType <- case cipher.type of

@@ -124,7 +171,7 @@ decodeCipher cipher = do

124 n

171 n

125 | cipherTypeLogin == n -> do

172 | cipherTypeLogin == n -> do

126 case JNullable.toMaybe cipher.login of

173 case JNullable.toMaybe cipher.login of

127− Nothing -> throwError $ error "Login data is missing"

174+ Nothing -> liftEffect $ throwError $ error "Login data is missing"

128 Just login -> do

175 Just login -> do

129 username <- decryptNullable login.username

176 username <- decryptNullable login.username

130 password <- decryptNullable login.password

177 password <- decryptNullable login.password

@@ -138,7 +185,7 @@ decodeCipher cipher = do

138 n

185 n

139 | cipherTypeCard == n -> do

186 | cipherTypeCard == n -> do

140 case JNullable.toMaybe cipher.card of

187 case JNullable.toMaybe cipher.card of

141− Nothing -> throwError $ error "Card data is missing"

188+ Nothing -> liftEffect $ throwError $ error "Card data is missing"

142 Just card -> do

189 Just card -> do

143 cardholderName <- decryptNullable card.cardholderName

190 cardholderName <- decryptNullable card.cardholderName

144 number <- decryptNullable card.number

191 number <- decryptNullable card.number

@@ -152,7 +199,7 @@ decodeCipher cipher = do

152 n

199 n

153 | cipherTypeIdentity == n -> do

200 | cipherTypeIdentity == n -> do

154 case JNullable.toMaybe cipher.identity of

201 case JNullable.toMaybe cipher.identity of

155− Nothing -> throwError $ error "Identity data is missing"

202+ Nothing -> liftEffect $ throwError $ error "Identity data is missing"

156 Just identity -> do

203 Just identity -> do

157 firstName <- decryptNullable identity.firstName

204 firstName <- decryptNullable identity.firstName

158 middleName <- decryptNullable identity.middleName

205 middleName <- decryptNullable identity.middleName

@@ -193,14 +240,19 @@ decodeCipher cipher = do

193 , title

240 , title

194 , username

241 , username

195 }

242 }

196− n -> throwError $ error $ "Unsupported cipher type: " <> show n

243+ n -> liftEffect $ throwError $ error $ "Unsupported cipher type: " <> show n

197 pure $ Bridge.Sub_LoadCipher { cipherType, name, id: cipher.id }

244 pure $ Bridge.Sub_LoadCipher { cipherType, name, id: cipher.id }

198

245

199decryptNullable ::

246decryptNullable ::

200 forall x r.

247 forall x r.

201 Newtype x (Maybe String) =>

248 Newtype x (Maybe String) =>

202− HasL "crypto" CryptoService r =>

203− HasL "key" SymmetricCryptoKey r =>

204 JNullable EncryptedString ->

249 JNullable EncryptedString ->

250+ Run

251+ ( key :: Reader SymmetricCryptoKey

252+ , crypto :: Reader CryptoService

253+ , aff :: Aff

254+ , effect :: Effect

205− Al r x

255+ | r

256+ )

257+ x

206decryptNullable x = wrap <<< fromJNullable Nothing <<< map Just <$> (traverse decrypt x)

258decryptNullable x = wrap <<< fromJNullable Nothing <<< map Just <$> (traverse decrypt x)

backend/Main.purs+127−70

@@ -3,15 +3,13 @@ module Main

3 ) where

5import Prelude

6−import BW (ApiService, CryptoService, Services)

6+import BW (ApiService, CryptoService, Services, CryptoFunctions)

7import BW as WB

8import BW.Logic (decodeCipher, decrypt, hashPassword, liftPromise)

9import BW.Logic as Logic

10import BW.Types (CipherResponse, Email(..), Password(..), Urls, cipherTypeCard, cipherTypeIdentity, cipherTypeLogin, cipherTypeSecureNote)

11import Bridge as Bridge

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

13import Control.Monad.Error.Class (catchError, throwError)

12import Control.Monad.Error.Class (catchError, throwError)

14−import Control.Monad.Reader (runReaderT)

15import Data.Argonaut (class DecodeJson)

13import Data.Argonaut (class DecodeJson)

16import Data.Array as Array

14import Data.Array as Array

17import Data.Clipboard as Clipboard

15import Data.Clipboard as Clipboard

@@ -37,7 +35,11 @@ import FFI (Elm)

37import FFI as FFI

35import FFI as FFI

38import Localstorage (class StorageKey)

36import Localstorage (class StorageKey)

39import Localstorage as Storage

37import Localstorage as Storage

38+import Run (AFF, EFFECT, Run, liftAff, runBaseAff')

39+import Run.Reader (Reader, askAt, runReaderAt)

40import Storage (MasterPasswordHashKey(..), PreloginResponseKey(..), SyncKey(..), TokenKey(..), UrlsKey(..))

41+import Type.Prelude (Proxy(..))

42+import Type.Row (type (+))

41import Untagged.Union (toEither1)

43import Untagged.Union (toEither1)

42import Web.HTML as Html

44import Web.HTML as Html

43import Web.HTML.Window as Window

45import Web.HTML.Window as Window

@@ -55,21 +57,50 @@ main = do

55 Ref.write (Just captchaToken) hCaptchaTokenRef

57 Ref.write (Just captchaToken) hCaptchaTokenRef

56 Elm.send app Bridge.CaptchaDone

58 Elm.send app Bridge.CaptchaDone

57 let

59 let

60+ runAff act = runElmAff app $ run $ act

61+

62+ run ::

63+ forall a.

64+ Run

65+ ( app :: Reader Elm

66+ , aff :: Aff

67+ , effect :: Effect

68+ , crypto :: Reader CryptoService

69+ , storage :: Reader Storage

70+ , services :: Reader Services

71+ , cryptoFunctions :: Reader CryptoFunctions

72+ )

73+ a ->

74+ Run (EFFECT + AFF + ()) a

58− run act = do

75+ run act =

76+ runReaderAt (Proxy :: _ "app") app

77+ $ runReaderAt (Proxy :: _ "crypto") services.crypto

78+ $ runReaderAt (Proxy :: _ "storage") storage

79+ $ runReaderAt (Proxy :: _ "services") services

80+ $ runReaderAt (Proxy :: _ "cryptoFunctions") services.cryptoFunctions

81+ $ act

82+

83+ runWithDecryptionKey ::

84+ Run

85+ ( app :: Reader Elm

86+ , aff :: Aff

87+ , effect :: Effect

88+ , key :: Reader SymmetricCryptoKey

89+ , crypto :: Reader CryptoService

90+ , storage :: Reader Storage

91+ , services :: Reader Services

92+ , cryptoFunctions :: Reader CryptoFunctions

93+ )

94+ Unit ->

95+ Effect Unit

96+ runWithDecryptionKey act = do

59 maybeKey <- Ref.read masterKeyRef

97 maybeKey <- Ref.read masterKeyRef

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

98+ runAff

61 $ case maybeKey of

99 $ case maybeKey of

62 Just masterKey -> do

100 Just masterKey -> do

63 token <- getOrReset TokenKey

101 token <- getOrReset TokenKey

64 key <- Logic.makeDecryptionKey masterKey token.key

102 key <- Logic.makeDecryptionKey masterKey token.key

65− liftEffect $ runElmAff app

103+ runReaderAt (Proxy :: _ "key") key $ act

66− $ runReaderT act

67− { app

68− , storage

69− , services

70− , crypto: services.crypto

71− , key

72− }

73 Nothing -> requestMasterPassword

104 Nothing -> requestMasterPassword

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

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

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

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

@@ -77,22 +108,17 @@ main = do

77 Ref.write Nothing hCaptchaTokenRef

108 Ref.write Nothing hCaptchaTokenRef

78 let

109 let

79 urls = baseUrl server

110 urls = baseUrl server

80− runElmAff app do

111+ runAff do

81 unauthedApi <- liftPromise $ services.getApi urls jnull

112 unauthedApi <- liftPromise $ services.getApi urls jnull

82− let

83− env =

84− { api: unauthedApi

85− , crypto: services.crypto

86− , storage

87− , cryptoFunctions: services.cryptoFunctions

88− , app

89− }

90− flip runReaderT env do

91− prelogin <- liftPromise $ unauthedApi.postPrelogin { email }

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

114+ runReaderAt (Proxy :: _ "api") unauthedApi do

92 loginResponse <-

115 loginResponse <-

116+ liftAff

93− catchError

117+ $ catchError

118+ ( runBaseAff' $ run $ runReaderAt (Proxy :: _ "api") unauthedApi

94− (Logic.getLogInRequestToken prelogin (Email email) (Password password) captchaToken)

119+ $ Logic.getLogInRequestToken prelogin (Email email) (Password password) captchaToken

120+ )

95− (const $ liftEffect $ Exc.throw "Could not log in. Please check your data and try again.")

121+ (const $ liftEffect $ Exc.throw "Could not log in. Please check your data and try again.")

96 case toEither1 loginResponse of

122 case toEither1 loginResponse of

97 Left { siteKey } -> send $ Bridge.NeedsCaptcha siteKey

123 Left { siteKey } -> send $ Bridge.NeedsCaptcha siteKey

98 Right token -> do

124 Right token -> do

@@ -110,7 +136,7 @@ main = do

110 Storage.store storage TokenKey token

136 Storage.store storage TokenKey token

111 send Bridge.LoginSuccessful

137 send Bridge.LoginSuccessful

112 Bridge.NeedCiphersList ->

138 Bridge.NeedCiphersList ->

113− run do

139+ runWithDecryptionKey do

114 sync <- getOrReset SyncKey

140 sync <- getOrReset SyncKey

115 ciphers <- traverse processCipher sync.ciphers

141 ciphers <- traverse processCipher sync.ciphers

116 let

142 let

@@ -121,21 +147,18 @@ main = do

121 WebStorage.clear storage

147 WebStorage.clear storage

122 Elm.send app Bridge.Reset

148 Elm.send app Bridge.Reset

123 Bridge.SendMasterPassword masterPassword ->

149 Bridge.SendMasterPassword masterPassword ->

124− runElmAff app

125− $ do

150+ runAff do

126− flip runReaderT { app: app, storage: storage, crypto: services.crypto, cryptoFunctions: services.cryptoFunctions }

127− $ do

128− hash <- getOrReset MasterPasswordHashKey

151+ hash <- getOrReset MasterPasswordHashKey

129− newHash <- hashPassword (Password masterPassword)

152+ newHash <- hashPassword (Password masterPassword)

130− if hash == newHash then do

153+ if hash == newHash then do

131− sync <- getOrReset SyncKey

154+ sync <- getOrReset SyncKey

132− prelogin <- getOrReset PreloginResponseKey

155+ prelogin <- getOrReset PreloginResponseKey

133− masterKey <- Logic.makePreloginKey prelogin (Email sync.profile.email) (Password masterPassword)

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

134− liftEffect $ Ref.write (Just masterKey) masterKeyRef

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

135− send Bridge.LoginSuccessful

158+ send Bridge.LoginSuccessful

136− else do

159+ else do

137− send $ Bridge.Error "The password is wrong. Please try again."

160+ send $ Bridge.Error "The password is wrong. Please try again."

138− requestMasterPassword

161+ requestMasterPassword

139 Bridge.Init -> do

162 Bridge.Init -> do

140 liftEffect $ Storage.get storage TokenKey

163 liftEffect $ Storage.get storage TokenKey

141 >>= \x ->

164 >>= \x ->

@@ -143,7 +166,7 @@ main = do

143 Just _ -> Bridge.LoginSuccessful

166 Just _ -> Bridge.LoginSuccessful

144 Nothing -> Bridge.NeedsLogin

167 Nothing -> Bridge.NeedsLogin

145 Bridge.RequestCipher id ->

168 Bridge.RequestCipher id ->

146− run do

169+ runWithDecryptionKey do

147 sync <- getOrReset SyncKey

170 sync <- getOrReset SyncKey

148 case Array.find (\c -> c.id == id) sync.ciphers of

171 case Array.find (\c -> c.id == id) sync.ciphers of

149 Nothing -> pure unit

172 Nothing -> pure unit

@@ -153,20 +176,26 @@ main = do

153 pure unit

176 pure unit

154 pure unit

177 pure unit

155 Bridge.NeedEmail ->

178 Bridge.NeedEmail ->

156− run do

179+ runWithDecryptionKey do

157 sync <- getOrReset SyncKey

180 sync <- getOrReset SyncKey

158 send $ Bridge.RecieveEmail sync.profile.email

181 send $ Bridge.RecieveEmail sync.profile.email

159 pure unit

182 pure unit

160 Bridge.Copy text ->

183 Bridge.Copy text ->

161− run do

184+ runWithDecryptionKey do

162 liftPromise $ Clipboard.clipboard text

185 liftPromise $ Clipboard.clipboard text

163 Bridge.Open uri -> openURL uri

186 Bridge.Open uri -> openURL uri

164

187

165processCipher ::

188processCipher ::

166 forall r.

189 forall r.

190+ CipherResponse ->

191+ Run

167− HasL "crypto" CryptoService r =>

192+ ( crypto :: Reader CryptoService

168− HasL "key" SymmetricCryptoKey r =>

193+ , key :: Reader SymmetricCryptoKey

194+ , aff :: Aff

195+ , effect :: Effect

196+ | r

197+ )

169− CipherResponse -> Al r { cipher :: Bridge.Sub_LoadCiphers, date :: DateTime }

198+ { cipher :: Bridge.Sub_LoadCiphers, date :: DateTime }

170processCipher cipher = do

199processCipher cipher = do

171 name <- decrypt cipher.name

200 name <- decrypt cipher.name

172 cipherType <- case cipher.type of

201 cipherType <- case cipher.type of

@@ -178,7 +207,7 @@ processCipher cipher = do

178 | n == cipherTypeCard -> pure Bridge.CardType

207 | n == cipherTypeCard -> pure Bridge.CardType

179 n

208 n

180 | n == cipherTypeIdentity -> pure Bridge.IdentityType

209 | n == cipherTypeIdentity -> pure Bridge.IdentityType

181− n -> throwError $ error $ "Unsupported cipher type: " <> show n

210+ n -> liftEffect $ throwError $ error $ "Unsupported cipher type: " <> show n

182 date <- liftEffect $ Timestamp.toDateTime cipher.revisionDate

211 date <- liftEffect $ Timestamp.toDateTime cipher.revisionDate

183 pure

212 pure

184 $ { cipher:

213 $ { cipher:

@@ -191,15 +220,17 @@ processCipher cipher = do

191 , date

220 , date

192 }

221 }

193

222

194−runElmAff :: FFI.Elm -> Aff Unit -> Effect Unit

223+runElmAff :: FFI.Elm -> Run (AFF + EFFECT + ()) Unit -> Effect Unit

195runElmAff app =

224runElmAff app =

196 runAff_

225 runAff_

197− $ \res -> do

226+ ( \res -> do

198 case res of

227 case res of

199 Left e -> do

228 Left e -> do

200 log $ show e

229 log $ show e

201 Elm.send app (Bridge.Error $ Exc.message e)

230 Elm.send app (Bridge.Error $ Exc.message e)

202 Right unit -> pure unit

231 Right unit -> pure unit

232+ )

233+ <<< runBaseAff'

203

234

204baseUrl :: String -> Urls

235baseUrl :: String -> Urls

205baseUrl server =

236baseUrl server =

@@ -215,46 +246,72 @@ baseUrl server =

215

246

216getOrReset ::

247getOrReset ::

217 forall k t r.

248 forall k t r.

218− HasL "app" Elm r =>

219− HasL "storage" Storage r =>

220 StorageKey k t =>

249 StorageKey k t =>

221 DecodeJson t =>

250 DecodeJson t =>

222− k -> Al r t

251+ k ->

252+ Run

253+ ( storage :: Reader Storage

254+ , app :: Reader Elm

255+ , effect :: Effect

256+ | r

257+ )

258+ t

223getOrReset key = do

259getOrReset key = do

224− storage <- l (L :: L "storage")

260+ storage <- askAt (Proxy :: _ "storage")

261+ app <- askAt (Proxy :: _ "app")

225 let

262 let

226 handleError = do

263 handleError = do

227− app <- l (L :: L "app")

228− liftEffect $ WebStorage.clear storage

264+ WebStorage.clear storage

229− liftEffect $ Elm.send app Bridge.Reset

265+ Elm.send app Bridge.Reset

230− liftEffect $ Exc.throw "Encountered an internal error. Resetting the app."

266+ Exc.throw "Encountered an internal error. Resetting the app."

231− try (liftEffect $ Storage.get storage key)

267+ liftEffect $ try (Storage.get storage key)

232 >>= \x -> case x of

268 >>= \x -> case x of

233 Left err -> do

269 Left err -> do

234− liftEffect $ log $ show err

270+ log $ show err

235 handleError

271 handleError

236 Right Nothing -> handleError

272 Right Nothing -> handleError

237 Right (Just y) -> pure y

273 Right (Just y) -> pure y

238

274

239getAuthedApi ::

275getAuthedApi ::

240 forall r.

276 forall r.

241− HasL "services" Services r =>

277+ Run

242− HasL "storage" Storage r =>

278+ ( storage :: Reader Storage

243− HasL "app" Elm r =>

279+ , app :: Reader Elm

280+ , aff :: Aff

281+ , effect :: Effect

282+ , services :: Reader Services

283+ | r

284+ )

244− Al r ApiService

285+ ApiService

245getAuthedApi = do

286getAuthedApi = do

246− services <- l (L :: L "services")

287+ services <- askAt (Proxy :: _ "services")

247 token <- getOrReset TokenKey

288 token <- getOrReset TokenKey

248 url <- getOrReset UrlsKey

289 url <- getOrReset UrlsKey

249 liftPromise $ services.getApi (baseUrl url) (nullify token)

290 liftPromise $ services.getApi (baseUrl url) (nullify token)

250

291

251−requestMasterPassword :: forall r. HasL "storage" Storage r => HasL "app" Elm r => Al r Unit

292+requestMasterPassword ::

293+ forall r.

294+ Run

295+ ( storage :: Reader Storage

296+ , app :: Reader Elm

297+ , effect :: Effect

298+ | r

299+ )

300+ Unit

252requestMasterPassword = do

301requestMasterPassword = do

253 url <- getOrReset UrlsKey

302 url <- getOrReset UrlsKey

254 sync <- getOrReset SyncKey

303 sync <- getOrReset SyncKey

255 send $ Bridge.NeedsMasterPassword $ Bridge.Sub_NeedsMasterPassword { server: url, login: sync.profile.email }

304 send $ Bridge.NeedsMasterPassword $ Bridge.Sub_NeedsMasterPassword { server: url, login: sync.profile.email }

256

305

257−send :: forall r. HasL "app" Elm r => Bridge.Sub -> Al r Unit

306+send ::

307+ forall r.

308+ Bridge.Sub ->

309+ Run

310+ ( app :: Reader Elm

311+ , effect :: Effect

312+ | r

313+ )

314+ Unit

258send sub = do

315send sub = do

259− app <- l (L :: L "app")

316+ app <- askAt (Proxy :: _ "app")

260 liftEffect $ Elm.send app sub

317 liftEffect $ Elm.send app sub

el/spago.dhalldeleted−14

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

1−{ name = "bw"

2−, dependencies =

3− [ "aff"

4− , "effect"

5− , "newtype"

6− , "prelude"

7− , "record"

8− , "test-unit"

9− , "transformers"

10− , "unsafe-coerce"

11− ]

12−, packages = ../packages.dhall

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

14−}

el/src/Control/El.pursdeleted−23

@@ -1,23 +0,0 @@

1−module Control.El (El, Al, l, class HasL, L(..)) where

2−

3−

4−import Control.Monad.Reader (class MonadAsk, ReaderT, asks)

5−import Data.Symbol (class IsSymbol, reflectSymbol)

6−import Effect (Effect)

7−import Effect.Aff (Aff)

8−import Prim.Row (class Cons, class Nub)

9−import Record.Unsafe (unsafeGet)

10−import Type.Proxy (Proxy(..))

11−

12−data L :: forall k. k -> Type

13−data L t = L

14−

15−type El r = ReaderT (Record r) Effect

16−type Al r = ReaderT (Record r) Aff

17−

18−l :: forall res r field m. MonadAsk (Record r) m => HasL field res r => IsSymbol field => L field -> m res

19−l L = asks (unsafeGet (reflectSymbol (Proxy :: Proxy field)))

20−

21−class HasL :: forall k1 k2 k3. k1 -> k2 -> k3 -> Constraint

22−class HasL field t r | field r -> t

23−instance (Cons field t r r', Nub r' r) => HasL field t r

el/test/Main.pursdeleted−27

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

1−module Test.Main

2− ( main

3− ) where

4−

5−import Prelude

6−import Test.Unit

7−import Control.El

8−import Control.Monad.Reader (runReaderT)

9−import Effect (Effect)

10−import Effect.Aff (launchAff_)

11−import Test.Unit.Assert as Assert

12−import Test.Unit.Output.Fancy (runTest)

13−import Type.Proxy (Proxy(..))

14−

15−main ∷ Effect Unit

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

23−

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

25−singleHandler = do

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

27− pure $ x + 1

packages.dhall−1

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

103 sha256:7a24ebdbacb2bfa27b2fc6ce3da96f048093d64e54369965a2a7b5d9892b6031

104

105in upstream

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

107 with argonaut-aeson-generic =

106 with argonaut-aeson-generic =

108 { dependencies =

107 { dependencies =

109 [ "argonaut-codecs"

108 [ "argonaut-codecs"

spago.dhall+1−1

@@ -26,7 +26,6 @@ to generate this file without the comments in this block.

26 , "datetime-parsing"

27 , "effect"

28 , "either"

29− , "el"

30 , "exceptions"

29 , "exceptions"

31 , "foldable-traversable"

30 , "foldable-traversable"

32 , "functions"

31 , "functions"

@@ -36,6 +35,7 @@ to generate this file without the comments in this block.

36 , "orders"

35 , "orders"

37 , "prelude"

36 , "prelude"

38 , "refs"

37 , "refs"

38+ , "run"

39 , "strings"

40 , "transformers"

41 , "tuples"