From d96bf9bb52fc6f92c3be6ae7acefb2e75c3a397b Mon Sep 17 00:00:00 2001
From: Elliot Glaysher <elliot@tlon.io>
Date: Tue, 1 Oct 2019 11:23:34 -0700
Subject: [PATCH] Booting fake ships other than zod

---
 pkg/king/app/CLI.hs  | 50 +++++++++++++++++++++++++++++++++++---------
 pkg/king/app/Main.hs | 18 ++++++++++++++--
 2 files changed, 56 insertions(+), 12 deletions(-)

diff --git a/pkg/king/app/CLI.hs b/pkg/king/app/CLI.hs
index 8a8380226..50d3ca5fa 100644
--- a/pkg/king/app/CLI.hs
+++ b/pkg/king/app/CLI.hs
@@ -1,7 +1,8 @@
 {-# OPTIONS_GHC -Werror -Wall #-}
 {-# LANGUAGE CPP #-}
 
-module CLI (parseArgs, Cmd(..), New(..), Run(..), Bug(..), Opts(..)) where
+module CLI (parseArgs, Cmd(..), BootType(..), New(..), Run(..), Bug(..),
+            Opts(..)) where
 
 import ClassyPrelude
 import Options.Applicative
@@ -26,12 +27,20 @@ data Opts = Opts
     }
   deriving (Show)
 
+data BootType
+  = BootComet
+  | BootFake Text
+  | BootFromKeyfile FilePath
+  deriving (Show)
+
 data New = New
+    -- TODO: Pill path needs to become optional; need to default to either the
+    -- git hash version or the release version per current vere.
     { nPillPath :: FilePath
-    , nShipAddr :: Text
+--    , nShipAddr :: Text
     , nPierPath :: Maybe FilePath -- Derived from ship name if not specified.
     , nArvoDir  :: Maybe FilePath
-    , nBootFake :: Bool
+    , nBootType :: BootType
     }
   deriving (Show)
 
@@ -118,27 +127,48 @@ parseArgs = do
 
 --------------------------------------------------------------------------------
 
+newComet :: Parser BootType
+newComet = flag' BootComet
+  (  long "comet"
+  <> help "Boot a new comet")
+
+newFakeship :: Parser BootType
+newFakeship = BootFake <$> strOption
+                         (short 'F'
+                        <> long "fake"
+                        <> metavar "SHIP"
+                        <> help "Boot a fakeship")
+
+newFromKeyfile :: Parser BootType
+newFromKeyfile = BootFromKeyfile <$> strOption
+                             (short 'k'
+                            <> long "keyfile"
+                            <> metavar "KEYFILE"
+                            <> help "Boot from a keyfile")
+
 new :: Parser New
 new = do
-    nShipAddr <- strArgument
-                     $ metavar "SHIP"
-                    <> help "Ship address"
+    -- nShipAddr <- strArgument
+    --                  $ metavar "SHIP"
+    --                 <> help "Ship address"
 
     nPierPath <- optional
                $ strArgument
                      $ metavar "PIER"
                     <> help "Path to pier"
 
+    nBootType <- newComet <|> newFakeship <|> newFromKeyfile
+
     nPillPath <- strOption
                      $ short 'B'
                     <> long "pill"
                     <> metavar "PILL"
                     <> help "Path to pill file"
 
-    nBootFake <- switch
-                     $ short 'F'
-                    <> long "fake"
-                    <> help "Create a fake ship"
+    -- nBootFake <- switch
+    --                  $ short 'F'
+    --                 <> long "fake"
+    --                 <> help "Create a fake ship"
 
     nArvoDir <- option auto
                     $ metavar "PATH"
diff --git a/pkg/king/app/Main.hs b/pkg/king/app/Main.hs
index d1ab0d5e3..312daf028 100644
--- a/pkg/king/app/Main.hs
+++ b/pkg/king/app/Main.hs
@@ -113,6 +113,7 @@ import qualified Data.Set                    as Set
 import qualified Data.Text                   as T
 import qualified EventBrowser                as EventBrowser
 import qualified System.IO.LockFile.Internal as Lock
+import qualified Urbit.Ob                    as Ob
 import qualified Vere.Log                    as Log
 import qualified Vere.Pier                   as Pier
 import qualified Vere.Serf                   as Serf
@@ -316,9 +317,22 @@ validateNounVal inpVal = do
 
 newShip :: HasLogFunc e => CLI.New -> CLI.Opts -> RIO e ()
 newShip CLI.New{..} _ = do
-    tryBootFromPill nPillPath pierPath (Ship 0)
+    tryBootFromPill nPillPath pierPath shipId
   where
-    pierPath = fromMaybe ("./" <> unpack nShipAddr) nPierPath
+    shipId :: Ship
+    shipId = case nBootType of
+      CLI.BootComet -> error "Comets don't work yet"
+      CLI.BootFake txt -> case Ob.parsePatp txt of
+        Left x  -> error "Invalid ship name"
+        Right p -> Ship $ fromIntegral $ Ob.fromPatp p
+      CLI.BootFromKeyfile x -> error "Up next"
+
+    pierPath = case nPierPath of
+      Just x -> x
+      Nothing -> case nBootType of
+        CLI.BootComet         -> error "Comets don't work yet"
+        CLI.BootFake txt      -> "./" <> unpack txt
+        CLI.BootFromKeyfile x -> error "That's up next, make fakenec work first."
 
 runShip :: HasLogFunc e => CLI.Run -> CLI.Opts -> RIO e ()
 runShip (CLI.Run pierPath) _ = tryPlayShip pierPath