agent: adds post to welcome

agent/config/routes

@@ -8,6 +8,7 @@
 
 /v0/name                              NameR                    PATCH
 
+/v0/welcome/#Version                  WelcomeR                 POST
 /v0/specs                             SpecsR                   GET
 /v0/metrics                           MetricsR                 GET
 

agent/src/Handler/V0.hs

@@ -30,6 +30,7 @@ import           Lib.SystemPaths
 import           Lib.Ssh
 import           Lib.Tor
 import           Lib.Types.Core
+import           Lib.Types.Emver
 import           Model
 import           Settings
 import           Util.Function
@@ -76,6 +77,9 @@ getServerR = handleS9ErrT $ do
                 Left  e  -> throwE $ InvalidSshKeyE (toS e)
                 Right as -> pure $ uncurry3 SshKeyFingerprint <$> as
 
+postWelcomeR :: Version -> Handler ()
+postWelcomeR version = runDB $ repsert (WelcomeAckKey version) WelcomeAck
+
 getSpecs :: MonadIO m => AppSettings -> S9ErrT m SpecsRes
 getSpecs settings = do
     specsCPU        <- liftIO getCpuInfo

agent/src/Lib/Types/Emver.hs

@@ -57,7 +57,9 @@ instance Show Version where
 instance IsString Version where
     fromString s = either error id $ Atto.parseOnly parseVersion (T.pack s)
 instance Read Version where
-    readsPrec i = 
+    readsPrec _ s = case Atto.parseOnly parseVersion (T.pack s) of
+        Left _ -> []
+        Right a -> [(a, "")]
 
 -- | A change in the value found at 'major' implies a breaking change in the API that this version number describes
 major :: Version -> Word

agent/src/Lib/Types/Emver/Orphans.hs

@@ -32,17 +32,19 @@ instance FromJSON VersionRange where
 instance PersistField Version where
     toPersistValue   = toPersistValue @Text . show
     fromPersistValue = first T.pack . Atto.parseOnly parseVersion <=< fromPersistValue
-
 instance PersistFieldSql Version where
     sqlType _ = SqlString
+instance FromHttpApiData Version where
+    parseUrlPiece = first toS . Atto.parseOnly parseVersion
+instance ToHttpApiData Version where
+    toUrlPiece = show
+
+instance PathPiece Version where
+    toPathPiece   = show
+    fromPathPiece = hush . Atto.parseOnly parseVersion
 
 instance PathPiece VersionRange where
     toPathPiece   = show
     fromPathPiece = hush . Atto.parseOnly parseRange
 
-instance FromHttpApiData Version where
-    parseUrlPiece = first toS . Atto.parseOnly parseVersion
 
-instance PathPiece Version where
-    toPathPiece   = show
-    fromPathPiece = hush . Atto.parseOnly parseVersion