aa9755c · warden · git.iko.soy

backend/BW.purs+2−1

@@ -13,6 +13,7 @@ import Data.JNullable (JNullable)

1313import Data.SymmetricCryptoKey (SymmetricCryptoKey)

1414import Effect (Effect)

1515import Effect.Unsafe (unsafePerformEffect)

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

1617

1718type CryptoService

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

@@ -26,7 +27,7 @@ type ApiService

2627 = { postPrelogin :: PreloginRequest -> Promise PreloginResponse

2728 , getProfile :: Unit -> Promise ProfileResponse

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

29− , postIdentityToken :: PasswordTokenRequest -> Promise IdentityTokenResponse

30+ , postIdentityToken :: PasswordTokenRequest -> Promise (IdentityCaptchaResponse |+| IdentityTokenResponse)

3031 , getSync :: Unit -> Promise SyncResponse

3132 }

3233

backend/BW/Logic.purs+6−3

@@ -15,6 +15,8 @@ import Data.JNullable as JNullable

1515import Data.JOpt (fromJOpt)

1616import Data.Maybe (Maybe(..))

1717import Data.Newtype (class Newtype, wrap)

18+import Data.JNullable (jnull, nullify)

19+import Data.Maybe (Maybe, fromMaybe)

1820import Data.String as String

1921import Data.SymmetricCryptoKey (SymmetricCryptoKey)

2022import Data.SymmetricCryptoKey as SymmetricCryptoKey

@@ -23,6 +25,7 @@ import Effect.Aff.Class (class MonadAff, liftAff)

2325import Effect.Class (liftEffect)

2426import Effect.Exception (error)

2527import Effect.Exception as Exc

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

2629

2730-- | Creates the master key

2831makePreloginKey ::

@@ -60,8 +63,8 @@ getLogInRequestToken ::

6063 forall r.

6164 HasL "api" ApiService r =>

6265 HasL "crypto" CryptoService r =>

63− PreloginResponse -> Email -> Password -> Al r IdentityTokenResponse

64−getLogInRequestToken prelogin email password = do

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

67+getLogInRequestToken prelogin email password captchaResponse = do

6568 key <- makePreloginKey prelogin email password

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

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

@@ -73,7 +76,7 @@ getLogInRequestToken prelogin email password = do

7376 $ api.postIdentityToken

7477 { email: email

7578 , masterPasswordHash: hashedPassword

76− , captchaResponse: ""

79+ , captchaResponse: fromMaybe "" captchaResponse

7780 , twoFactor:

7881 { provider: twoFactorProviderTypeEmail

7982 , token: ""

backend/BW/Types.purs+4−1

@@ -36,7 +36,7 @@ type ProfileResponse

3636 , name :: String

3737 , email :: String

3838 , emailVerified :: Boolean

39− , masterPasswordHint :: String

39+ , masterPasswordHint :: JNullable String

4040 , premiumPersonally :: Boolean

4141 -- , premiumFromOrganization :: Boolean

4242 , culture :: String

@@ -338,6 +338,9 @@ derive newtype instance Ord RefreshToken

338338derive newtype instance EncodeJson RefreshToken

339339derive newtype instance DecodeJson RefreshToken

340340

341+type IdentityCaptchaResponse =

342+ { siteKey :: String

343+ }

341344

342345type IdentityTokenResponse

343346 = { accessToken :: AccessToken

backend/Bridge.purs+3−1

@@ -526,10 +526,12 @@ derive instance eqSub_NeedsMasterPassword :: Eq Sub_NeedsMasterPassword

526526derive instance ordSub_NeedsMasterPassword :: Ord Sub_NeedsMasterPassword

527527

528528data Sub =

529− Error String

529+ CaptchaDone

530+ | Error String

530531 | LoadCipher Sub_LoadCipher

531532 | LoadCiphers Sub_LoadCiphers_List

532533 | LoginSuccessful

534+ | NeedsCaptcha String

533535 | NeedsLogin

534536 | NeedsMasterPassword Sub_NeedsMasterPassword

535537 | RecieveEmail String

backend/Data/HCaptcha.js−1

@@ -5,6 +5,5 @@ export function bindHCaptchToken(callback) {

55 callback(e.data.hCaptchaToken)();

66 }

77 })

8−

98 }

109}

backend/Main.purs+28−16

@@ -20,6 +20,7 @@ import Data.Either (Either(..))

2020import Data.HCaptcha (bindHCaptchToken)

2121import Data.JNullable (jnull, nullify)

2222import Data.Maybe (Maybe(..))

23+import Data.Newtype (wrap)

2324import Data.OpenURL (openURL)

2425import Data.Ord.Down (Down(..))

2526import Data.SymmetricCryptoKey (SymmetricCryptoKey)

@@ -38,6 +39,7 @@ import FFI as FFI

3839import Localstorage (class StorageKey)

3940import Localstorage as Storage

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

42+import Untagged.Union (toEither1)

4143import Web.HTML as Html

4244import Web.HTML.Window as Window

4345import Web.Storage.Storage (Storage)

@@ -49,7 +51,10 @@ main = do

4951 storage <- Html.window >>= Window.localStorage

5052 services <- WB.getServices

5153 masterKeyRef <- Ref.new Nothing

52− bindHCaptchToken log

54+ hCaptchaTokenRef <- Ref.new Nothing

55+ bindHCaptchToken \captchaToken -> do

56+ Ref.write (Just captchaToken) hCaptchaTokenRef

57+ Elm.send app Bridge.CaptchaDone

5358 let

5459 run act = do

5560 maybeKey <- Ref.read masterKeyRef

@@ -69,6 +74,8 @@ main = do

6974 Nothing -> requestMasterPassword

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

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

77+ captchaToken <- Ref.read hCaptchaTokenRef

78+ Ref.write Nothing hCaptchaTokenRef

7279 let

7380 urls = baseUrl server

7481 runElmAff app do

@@ -82,23 +89,28 @@ main = do

8289 }

8390 flip runReaderT env do

8491 prelogin <- liftPromise $ unauthedApi.postPrelogin { email }

85− token <-

92+ loginResponse <-

8693 catchError

87− (Logic.getLogInRequestToken prelogin (Email email) (Password password))

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

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

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

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

91− sync <- liftPromise $ api.getSync unit

92− hash <- hashPassword (Password password)

93− log $ show sync

94− liftEffect do

95− Ref.write (Just masterKey) masterKeyRef

96− Storage.store storage UrlsKey server

97− Storage.store storage MasterPasswordHashKey hash

98− Storage.store storage PreloginResponseKey prelogin

99− Storage.store storage SyncKey sync

100− Storage.store storage TokenKey token

101− Elm.send app Bridge.LoginSuccessful

96+ case toEither1 loginResponse of

97+ Left { siteKey } ->

98+ liftEffect do

99+ Elm.send app $ Bridge.NeedsCaptcha siteKey

100+ Right token -> do

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

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

103+ sync <- liftPromise $ api.getSync unit

104+ hash <- hashPassword (Password password)

105+ log $ show sync

106+ liftEffect do

107+ Ref.write (Just masterKey) masterKeyRef

108+ Storage.store storage UrlsKey server

109+ Storage.store storage MasterPasswordHashKey hash

110+ Storage.store storage PreloginResponseKey prelogin

111+ Storage.store storage SyncKey sync

112+ Storage.store storage TokenKey token

113+ Elm.send app Bridge.LoginSuccessful

102114 Bridge.NeedCiphersList ->

103115 run do

104116 sync <- getOrReset SyncKey

bridge.yaml+2

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

11Sub:

22- NeedsLogin

3+- NeedsCaptcha: String

4+- CaptchaDone

35- Error: String

46- LoadCiphers:

57 List:

frontend/Bridge.elm+8−2

@@ -624,10 +624,12 @@ jsonEncSub_NeedsMasterPassword val =

624624

625625

626626type Sub =

627− Error String

627+ CaptchaDone

628+ | Error String

628629 | LoadCipher Sub_LoadCipher

629630 | LoadCiphers Sub_LoadCiphers_List

630631 | LoginSuccessful

632+ | NeedsCaptcha String

631633 | NeedsLogin

632634 | NeedsMasterPassword Sub_NeedsMasterPassword

633635 | RecieveEmail String

@@ -636,10 +638,12 @@ type Sub =

636638jsonDecSub : Json.Decode.Decoder ( Sub )

637639jsonDecSub =

638640 let jsonDecDictSub = Dict.fromList

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

641+ [ ("CaptchaDone", Json.Decode.lazy (\_ -> Json.Decode.succeed CaptchaDone))

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

640643 , ("LoadCipher", Json.Decode.lazy (\_ -> Json.Decode.map LoadCipher (jsonDecSub_LoadCipher)))

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

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

646+ , ("NeedsCaptcha", Json.Decode.lazy (\_ -> Json.Decode.map NeedsCaptcha (Json.Decode.string)))

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

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

645649 , ("RecieveEmail", Json.Decode.lazy (\_ -> Json.Decode.map RecieveEmail (Json.Decode.string)))

@@ -651,10 +655,12 @@ jsonDecSub =

651655jsonEncSub : Sub -> Value

652656jsonEncSub val =

653657 let keyval v = case v of

658+ CaptchaDone -> ("CaptchaDone", encodeValue (Json.Encode.list identity []))

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

655660 LoadCipher v1 -> ("LoadCipher", encodeValue (jsonEncSub_LoadCipher v1))

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

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

663+ NeedsCaptcha v1 -> ("NeedsCaptcha", encodeValue (Json.Encode.string v1))

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

659665 NeedsMasterPassword v1 -> ("NeedsMasterPassword", encodeValue (jsonEncSub_NeedsMasterPassword v1))

660666 RecieveEmail v1 -> ("RecieveEmail", encodeValue (Json.Encode.string v1))

frontend/Main.elm+41

@@ -7,6 +7,7 @@ import Html exposing (..)

77import Html.Lazy as Lazy

88import List.Nonempty as Nonempty exposing (Nonempty(..))

99import Notification

10+import Pages.Captcha as Captcha

1011import Pages.Cipher as Cipher

1112import Pages.Ciphers as Ciphers

1213import Pages.Loader exposing (loader)

@@ -38,6 +39,8 @@ type Msg

3839 | RecieveEmail String

3940 | Copy String

4041 | Open String

42+ | CaptchaMsg Captcha.Msg

43+ | ShowCaptcha Captcha.HCaptchSiteKey

4144

4245

4346type alias CipherId =

@@ -62,6 +65,7 @@ type PageModel

6265 | CiphersModel Ciphers.Model

6366 | MasterPasswordModel MasterPassword.Model

6467 | CipherModel Cipher.Model

68+ | CaptchaModel Captcha.Model

6569

6670

6771showPage :

@@ -124,6 +128,16 @@ showPage email page =

124128 , topButton = Just (BackButton PopView)

125129 }

126130

131+ CaptchaModel model ->

132+ let

133+ p =

134+ Captcha.page captchaCallbacks CaptchaMsg

135+ in

136+ { title = p.title model

137+ , body = p.view model

138+ , topButton = Just (BackButton PopView)

139+ }

140+

127141

128142main : Program () Model Msg

129143main =

@@ -163,6 +177,12 @@ subscriptions _ =

163177

164178 Bridge.RecieveEmail email ->

165179 RecieveEmail email

180+

181+ Bridge.NeedsCaptcha uri ->

182+ ShowCaptcha uri

183+

184+ Bridge.CaptchaDone ->

185+ PopView

166186 )

167187

168188

@@ -228,6 +248,10 @@ update msg model =

228248 appendPageStack mdl =

229249 { model | pageStack = model.pageStack |> Nonempty.toList |> List.filter (doNotStoreInHistory >> not) |> Nonempty mdl }

230250

251+ keepStackWith : PageModel -> Model

252+ keepStackWith mdl =

253+ { model | pageStack = Nonempty.cons mdl model.pageStack }

254+

231255 currentPage =

232256 model.pageStack |> Nonempty.head

233257 in

@@ -339,6 +363,18 @@ update msg model =

339363 Open uri ->

340364 ( model, FFI.sendBridge (Bridge.Open uri) )

341365

366+ ShowCaptcha uri ->

367+ (Captcha.page captchaCallbacks CaptchaMsg).init uri

368+ |> Tuple.mapFirst (\pageModel -> keepStackWith <| CaptchaModel pageModel)

369+

370+ CaptchaMsg imsg ->

371+ case currentPage of

372+ CaptchaModel page ->

373+ (Captcha.page captchaCallbacks CaptchaMsg).update imsg page |> processPage CaptchaModel

374+

375+ _ ->

376+ ( model, Cmd.none )

377+

342378

343379loginCallbacks : Login.Callbacks Msg

344380loginCallbacks =

@@ -355,6 +391,11 @@ cipherCallbacks =

355391 { copy = Copy, open = Open }

356392

357393

394+captchaCallbacks : Captcha.Callbacks

395+captchaCallbacks =

396+ {}

397+

398+

358399masterPasswordCallbacks : MasterPassword.Callbacks Msg

359400masterPasswordCallbacks =

360401 { submit = SendMasterPassword

frontend/Pages/Captcha.elmnew file+57

@@ -0,0 +1,57 @@

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

2+

3+import Html exposing (..)

4+import Html.Attributes as Attr

5+import Page exposing (..)

6+import Utils exposing (..)

7+

8+

9+type alias HCaptchSiteKey =

10+ String

11+

12+

13+type alias Model =

14+ { siteKey : HCaptchSiteKey

15+ }

16+

17+

18+type Msg

19+ = Noop

20+

21+

22+type alias Callbacks =

23+ {}

24+

25+

26+page : Callbacks -> Page HCaptchSiteKey Model Msg emsg

27+page callbacks liftMsg =

28+ { init = \siteKey -> Tuple.mapSecond (Cmd.map liftMsg) (init siteKey)

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

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

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

32+ , title = always "Captcha"

33+ }

34+

35+

36+init : HCaptchSiteKey -> ( Model, Cmd Msg )

37+init siteKey =

38+ ( { siteKey = siteKey }, Cmd.none )

39+

40+

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

42+update _ _ msg model =

43+ case msg of

44+ Noop ->

45+ ( Ok model, Cmd.none )

46+

47+

48+subscriptions : Model -> Sub Msg

49+subscriptions model =

50+ Sub.none

51+

52+

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

54+view { siteKey } =

55+ [ div [ Attr.class "u-embedded-media" ]

56+ [ iframe [ Attr.src ("https://iko.soy/warden/hcaptcha.html?" ++ siteKey) ] [] ]

57+ ]

frontend/Pages/Login.elm+12−11

@@ -38,8 +38,8 @@ page callbacks liftMsg =

3838

3939init : ( Model, Cmd Msg )

4040init =

41− ( { server = "https://bitwarden.iko.soy"

42− , email = "mail@iko.soy"

41+ ( { server = "https://vault.bitwarden.com"

42+ , email = "ilyakooo0@gmail.com"

4343 , password = ""

4444 }

4545 , Cmd.none

@@ -70,31 +70,32 @@ subscriptions model =

7070view : Model -> List (Html Msg)

7171view model =

7272 [ form [ Ev.onSubmit Submit ]

73− [ label [] [ text "Server" ]

74− , input

73+ ([ label [] [ text "Server" ]

74+ , input

7575 [ Attr.type_ "url"

7676 , Attr.value model.server

7777 , Ev.onInput UpdateServer

7878 , Attr.attribute "autocomplete" "url"

7979 ]

8080 []

81− , label [] [ text "Email" ]

82− , input

81+ , label [] [ text "Email" ]

82+ , input

8383 [ Attr.type_ "email"

8484 , Attr.value model.email

8585 , Ev.onInput UpdateEmail

8686 , Attr.attribute "autocomplete" "email"

8787 ]

8888 []

89− , label [] [ text "Password" ]

90− , input

89+ , label [] [ text "Password" ]

90+ , input

9191 [ Attr.type_ "password"

9292 , Attr.value model.password

9393 , Ev.onInput UpdatePassword

9494 , Attr.attribute "autocomplete" "current-password"

9595 ]

9696 []

97− , iframe [ Attr.src "https://iko.soy/warden/hcaptcha.html" ] []

98− , alignRight [ button [ Attr.type_ "submit" ] [ text "Log in" ] ]

99− ]

97+ ]

98+ -- ++ maybeList model.siteKey (\siteKey -> iframe [ Attr.src ("https://iko.soy/warden/hcaptcha.html?" ++ siteKey) ] [])

99+ ++ [ alignRight [ button [ Attr.type_ "submit" ] [ text "Log in" ] ] ]

100+ )

100101 ]

packages.dhall+16−1

@@ -144,5 +144,20 @@ in upstream

144144 , "unsafe-coerce"

145145 ]

146146 , repo = "https://github.com/ilyakooo0/purescript-untagged-union.git"

147− , version = "ps-15"

147+ , version = "iko/ps-15"

148+ }

149+ with literals =

150+ { repo = "https://github.com/ilyakooo0/purescript-literals.git"

151+ , version = "iko/_null"

152+ , dependencies =

153+ [ "assert"

154+ , "effect"

155+ , "integers"

156+ , "maybe"

157+ , "numbers"

158+ , "partial"

159+ , "prelude"

160+ , "typelevel-prelude"

161+ , "unsafe-coerce"

162+ ]

148163 }

spago.dhall+1

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

4141 , "tuples"

4242 , "typelevel-prelude"

4343 , "undefined-is-not-a-problem"

44+ , "untagged-union"

4445 , "web-html"

4546 , "web-storage"

4647 ]