From 02337c39e1197012cf9af90f1a73e1427820fbdb Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@riseup.net>
Date: Thu, 17 Oct 2019 09:57:46 +0000
Subject: [PATCH] UI: Take SSH public key in 1 field, then split into key type
and content
---
src/Vervis/Field/Key.hs | 64 ++++++++++++++++-------------------------
src/Vervis/Form/Key.hs | 12 +++++---
2 files changed, 33 insertions(+), 43 deletions(-)
diff --git a/src/Vervis/Field/Key.hs b/src/Vervis/Field/Key.hs
index b265749..4d25872 100644
--- a/src/Vervis/Field/Key.hs
+++ b/src/Vervis/Field/Key.hs
@@ -1,6 +1,6 @@
{- This file is part of Vervis.
-
- - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ - Written in 2016, 2019 by fr33domlover <fr33domlover@riseup.net>.
-
- ♡ Copying is an act of love. Please copy, reuse and share.
-
@@ -15,25 +15,21 @@
module Vervis.Field.Key
( nameField
- , algoField
- , contentField
+ , sshKeyField
)
where
import Data.ByteString (ByteString)
-import Data.ByteString.Base64 (decode)
import Data.Char (isDigit)
import Data.Maybe (isNothing)
import Data.Text (Text)
-import Data.Text.Encoding (encodeUtf8, decodeUtf8With)
-import Data.Text.Encoding.Error (lenientDecode)
+import Data.Text.Encoding
import Database.Esqueleto
import Database.Persist (checkUnique)
-import Yesod.Form.Fields (textField)
-import Yesod.Form.Functions (check, checkBool, checkM, convertField)
-import Yesod.Form.Types (Field)
+import Yesod.Form
import Yesod.Persist.Core (runDB)
+import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Char8 as BC
import qualified Data.Text as T
@@ -43,11 +39,26 @@ import Vervis.Foundation
import Vervis.Model
import Vervis.Model.Ident (text2ky)
-mkBsField :: Field Handler Text -> Field Handler ByteString
-mkBsField = convertField encodeUtf8 (decodeUtf8With lenientDecode)
-
-bsField :: Field Handler ByteString
-bsField = mkBsField textField
+sshKeyField :: Field Handler (ByteString, ByteString)
+sshKeyField = checkMMap (pure . parseKey) renderKey textField
+ where
+ parseKey t =
+ case T.words t of
+ a:c:_ ->
+ (,) <$> parseAlgo a
+ <*> parseContent c
+ _ -> Left "Key type or content is missing"
+ where
+ parseAlgo t =
+ let b = encodeUtf8 t
+ in if b `elem` supportedKeyAlgos
+ then Right b
+ else Left $ "Key type not supported: " <> t
+ parseContent t =
+ case B64.decode $ encodeUtf8 t of
+ Left s -> Left $ T.pack s
+ Right b -> Right b
+ renderKey (a, c) = T.concat [decodeUtf8 a, " ", decodeUtf8 c]
checkNameUnique :: PersonId -> Field Handler Text -> Field Handler Text
checkNameUnique pid = checkM $ \ ident -> do
@@ -64,28 +75,3 @@ checkNameUnique pid = checkM $ \ ident -> do
nameField :: PersonId -> Field Handler Text
nameField pid = checkNameUnique pid textField
-
-checkAlgoSupported :: Field Handler ByteString -> Field Handler ByteString
-checkAlgoSupported =
- let ok = (`elem` supportedKeyAlgos)
- msg :: Text
- msg = "This algorithm isn't supported"
- in checkBool ok msg
-
-algoField :: Field Handler ByteString
-algoField = checkAlgoSupported bsField
-
-checkContent :: Field Handler ByteString -> Field Handler ByteString
-checkContent =
- {-let lasts = (== '=')
- rest c = isAsciiLetter c || isDigit c || c == '+' || c == '/'
- ok b = BC.all rest $ BC.dropWhileEnd lasts b
- msg :: Text
- msg = "Must be a base64-encoded public SSH key"-}
- check $ \ t ->
- case decode t of
- Left s -> Left $ T.pack s
- Right b -> Right b
-
-contentField :: Field Handler ByteString
-contentField = checkContent bsField
diff --git a/src/Vervis/Form/Key.hs b/src/Vervis/Form/Key.hs
index 263ad69..ef0a28b 100644
--- a/src/Vervis/Form/Key.hs
+++ b/src/Vervis/Form/Key.hs
@@ -28,11 +28,15 @@ import Vervis.Model
import Vervis.Model.Ident
newKeyAForm :: PersonId -> AForm Handler SshKey
-newKeyAForm pid = SshKey
+newKeyAForm pid = mk
<$> (text2ky <$> areq (nameField pid) "Name*" Nothing)
- <*> pure pid
- <*> areq algoField "Algorithm*" Nothing
- <*> areq contentField "Content*" Nothing
+ <*> areq sshKeyField "Content*" (Just defKey)
+ where
+ mk n (a, c) = SshKey n pid a c
+ defKey =
+ ( "ssh-rsa"
+ , "VGhpcyBpcyBub3QgYSBrZXksIHBsZWFzZSBwYXN0ZSBhIHJlYWwgb25lIDopCg=="
+ )
newKeyForm :: PersonId -> Form SshKey
newKeyForm = renderDivs . newKeyAForm