surtr: ...

1 files changed, 46 insertions, 0 deletions

diff --git a/hosts/surtr/email/spm/provision/Spm/Provision.hs b/hosts/surtr/email/spm/provision/Spm/Provision.hs
new file mode 100644
index 00000000..ff18baa0
--- /dev/null
+++ b/hosts/surtr/email/spm/provision/Spm/Provision.hs
@@ -0,0 +1,46 @@
+module Spm.Provision
+  ( main
+  ) where
+
+import Prelude
+import Options.Applicative
+import Control.Monad
+
+import qualified Data.Text.IO as Text
+
+import qualified Data.UUID as UUID
+import qualified Data.UUID.V4 as UUID
+
+import Crypto.JOSE.JWK
+
+import qualified Data.ByteString.Lazy.Char8 as CLBS
+import qualified Data.Aeson as JSON
+
+import Control.Lens
+
+
+data Command
+  = InstanceId
+  | JwkSet
+  deriving stock (Eq, Ord, Read, Show)
+
+cmdInstanceId :: IO ()
+cmdInstanceId = Text.putStrLn . UUID.toText =<< UUID.nextRandom
+
+cmdJwkSet :: IO ()
+cmdJwkSet = do
+  k' <- genJWK (OKPGenParam Ed25519)
+  kid <- UUID.nextRandom
+  let k = k' & jwkKid ?~ UUID.toText kid
+             & jwkUse ?~ Sig
+             & jwkKeyOps ?~ [Sign, Verify]
+  CLBS.putStrLn . JSON.encode . JWKSet $ pure k
+
+opts :: Parser (IO ())
+opts = subparser $
+     command "instance-id" (info (pure cmdInstanceId) idm)
+  <> command "jwk-set" (info (pure cmdJwkSet) idm)
+
+  
+main :: IO ()
+main = join $ execParser (info opts idm)