Merge pull request #37 from Start9Labs/feature/timestamps

Feature/timestamps

resources/apps/apps.yaml

@@ -1,22 +1,163 @@
 bitcoind:
-  title: "Bitcoin Core"
-  description:
-    short: "A Bitcoin Full Node"
-    long: "The bitcoin full node implementation by Bitcoin Core."
-  version-info:
-    - version: 0.18.1
-      release-notes: "Some stuff"
-    - version: 0.18.2
-      release-notes: "Some more stuff"
+  title: Bitcoin Core
   icon-type: png
-cups:
-  title: "Cups Messenger"
   description:
-    short: "P2P Encrypted messaging"
-    long: "Peer-to-peer encrypted messaging platform that operates over tor."
+    long: Bitcoin is an innovative payment network and a new kind of money. Bitcoin
+      uses peer-to-peer technology to operate with no central authority or banks;
+      managing transactions and the issuing of bitcoins is carried out collectively
+      by the network. Bitcoin is open-source; its design is public, nobody owns or
+      controls Bitcoin and everyone can take part. Through many of its unique properties,
+      Bitcoin allows exciting uses that could not be covered by any previous payment
+      system.
+    short: A Bitcoin Full Node by Bitcoin Core
   version-info:
-    - version: 0.2.1
-      release-notes: "Some stuff"
-    - version: 0.2.2
-      release-notes: "Some more stuff"
-  icon-type: png
+  - os-version-required: '>=0.2.5'
+    release-notes: https://github.com/bitcoin/bitcoin/blob/master/doc/release-notes/release-notes-0.20.1.md
+    dependencies: {}
+    version: 0.20.1.1
+    os-version-recommended: '>=0.2.5'
+  - os-version-required: '>=0.2.4'
+    release-notes: https://github.com/bitcoin/bitcoin/blob/master/doc/release-notes/release-notes-0.20.1.md
+    dependencies: {}
+    version: 0.20.1
+    os-version-recommended: '>=0.2.4'
+  - os-version-required: '*'
+    release-notes: https://github.com/bitcoin/bitcoin/blob/master/doc/release-notes/release-notes-0.20.0.md
+    dependencies: {}
+    version: 0.20.0
+    os-version-recommended: '*'
+  - os-version-required: '*'
+    release-notes: https://github.com/bitcoin/bitcoin/blob/master/doc/release-notes/release-notes-0.19.1.md
+    dependencies: {}
+    version: 0.19.1
+    os-version-recommended: '*'
+  - os-version-required: '*'
+    release-notes: https://github.com/bitcoin/bitcoin/blob/master/doc/release-notes/release-notes-0.19.0.1.md
+    dependencies: {}
+    version: 0.19.0
+    os-version-recommended: '*'
+  - os-version-required: '*'
+    release-notes: https://github.com/bitcoin/bitcoin/blob/master/doc/release-notes/release-notes-0.18.1.md
+    dependencies: {}
+    version: 0.18.1
+    os-version-recommended: '*'
+cups:
+  title: Cups Messenger
+  icon-type: png
+  description:
+    long: Cups is a private, self-hosted, peer-to-peer, Tor-based, instant messenger.
+      Unlike other end-to-end encrypted messengers, with Cups on the Embassy there
+      are no trusted third parties.
+    short: Real private messaging
+  version-info:
+  - os-version-required: '>=0.2.4'
+    release-notes: |
+      Features
+        - Adds instructions defined by EmbassyOS 0.2.4 instructions feature
+    dependencies: {}
+    version: 0.3.6
+    os-version-recommended: '>=0.2.4'
+  - os-version-required: '*'
+    release-notes: |
+      Bug Fixes
+        - Upgrade UI to gracefully handle Consulate browser
+    dependencies: {}
+    version: 0.3.5
+    os-version-recommended: '*'
+  - os-version-required: '*'
+    release-notes: |
+      Bug Fixes
+        - Register a SIGTERM handler for graceful shutdown
+    dependencies: {}
+    version: 0.3.4
+    os-version-recommended: '*'
+  - os-version-required: '*'
+    release-notes: |
+      Features
+        - Conversation manual refresh
+      Bug Fixes
+        - Contacts hilighting for unread messages
+        - Avatar first initial centering
+        - Styling improvements
+    dependencies: {}
+    version: 0.3.3
+    os-version-recommended: '*'
+  - os-version-required: '*'
+    release-notes: |
+      Features
+        - Conversation manual refresh
+      Bug Fixes
+        - Contacts hilighting for unread messages
+        - Avatar first initial centering
+        - Styling improvements
+    dependencies: {}
+    version: 0.3.2
+    os-version-recommended: '*'
+  - os-version-required: '*'
+    release-notes: |
+      Big UX overhaul, including the code requisite to power the new Cups Messenger mobile application.
+      Check out "Cups Messenger" on the iOS and Google Play store
+      - Usable from your phone without the Tor browser.
+      - New Dark Theme.
+      - Message Previews + Old conversation removal
+      - Fixes bugs from 0.3.0
+    dependencies: {}
+    version: 0.3.1
+    os-version-recommended: '*'
+  - os-version-required: '*'
+    release-notes: |
+      Big UX overhaul, including the code requisite to power the new Cups Messenger mobile application.
+      Check out "Cups Messenger" on the iOS and Google Play store
+      - Usable from your phone without the Tor browser.
+      - New Dark Theme.
+      - Message Previews + Old conversation removal
+    dependencies: {}
+    version: 0.3.0
+    os-version-recommended: '*'
+  - os-version-required: '*'
+    release-notes: Added headers for Consulate caching
+    dependencies: {}
+    version: 0.2.4
+    os-version-recommended: '*'
+  - os-version-required: '*'
+    release-notes: fix autofill for password field
+    dependencies: {}
+    version: 0.2.3
+    os-version-recommended: '*'
+  - os-version-required: '*'
+    release-notes: |
+      - Massive load-time improvements
+    dependencies: {}
+    version: 0.2.2
+    os-version-recommended: '*'
+  - os-version-required: '*'
+    release-notes: |
+      - Signin security improvements
+    dependencies: {}
+    version: 0.2.1
+    os-version-recommended: '*'
+  - os-version-required: '*'
+    release-notes: |
+      # Cups UI released
+      - Breaks compatibility with cups-cli 0.1.x
+    dependencies: {}
+    version: 0.2.0
+    os-version-recommended: '*'
+  - os-version-required: '*'
+    release-notes: |
+      # Alpha Release
+      - Send messages
+      - Recieve messages
+      - Contact book
+    dependencies: {}
+    version: 0.1.1
+    os-version-recommended: '*'
+  - os-version-required: '*'
+    release-notes: |
+      # Alpha Release
+      - Send messages
+      - Recieve messages
+      - Contact book
+    dependencies: {}
+    version: 0.1.0
+    os-version-recommended: '*'

src/Handler/Apps.hs

@@ -5,6 +5,7 @@
 {-# LANGUAGE TemplateHaskell  #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
 
 module Handler.Apps where
 
@@ -71,17 +72,31 @@ getEmbassyOsVersion = userAgentOsVersion
 getAppsManifestR :: Handler TypedContent
 getAppsManifestR = do
     osVersion                              <- getEmbassyOsVersion
-    appResourceFile                        <- (</> "apps" </> "apps.yaml") . resourcesDir . appSettings <$> getYesod
-    manifest@AppManifest { unAppManifest } <- liftIO (Yaml.decodeFileEither appResourceFile) >>= \case
+    appsDir <- (</> "apps") . resourcesDir . appSettings <$> getYesod
+    let appResourceFile = appsDir </> "apps.yaml"
+    manifest  <- liftIO (Yaml.decodeFileEither appResourceFile) >>= \case
         Left e -> do
             $logError "COULD NOT PARSE APP INDEX! CORRECT IMMEDIATELY!"
             $logError (show e)
             sendResponseStatus status500 ("Internal Server Error" :: Text)
         Right a -> pure a
+    m <- mapM (addFileTimestamp' appsDir) (HM.toList $ unAppManifest manifest)
+    let withServiceTimestamps = AppManifest $ HM.fromList m
     let pruned = case osVersion of
-            Nothing -> manifest
-            Just av -> AppManifest $ HM.mapMaybe (filterOsRecommended av) unAppManifest
+            Nothing -> withServiceTimestamps
+            Just av -> AppManifest $ HM.mapMaybe (filterOsRecommended av) $ unAppManifest withServiceTimestamps
     pure $ TypedContent "application/x-yaml" (toContent $ Yaml.encode pruned)
+    where
+        addFileTimestamp' :: (MonadHandler m, MonadIO m) => FilePath -> (AppIdentifier, StoreApp) -> m (AppIdentifier, StoreApp)
+        addFileTimestamp' dir (appId, service) = do
+            let ext = (Extension (toS appId) :: Extension "s9pk")
+            mostRecentVersion <- liftIO $ getMostRecentAppVersion dir ext
+            (v, _) <- case mostRecentVersion of
+                    Nothing -> notFound
+                    Just a -> pure $ unRegisteredAppVersion a
+            liftIO (addFileTimestamp dir ext service v) >>= \case
+                            Nothing -> notFound
+                            Just appWithTimestamp -> pure (appId, appWithTimestamp)
 
 getSysR :: Extension "" -> Handler TypedContent
 getSysR e = do
@@ -90,9 +105,7 @@ getSysR e = do
 
 getAppManifestR :: AppIdentifier -> Handler TypedContent
 getAppManifestR appId = do
-    appSettings <- appSettings <$> getYesod
-    let appsDir   = (</> "apps") . resourcesDir $ appSettings
-    let appMgrDir = staticBinDir $ appSettings
+    (appsDir, appMgrDir) <- getsYesod $ ((</> "apps") . resourcesDir &&& staticBinDir) . appSettings
     av <- getVersionFromQuery appsDir appExt >>= \case
         Nothing -> sendResponseStatus status400 ("Specified App Version Not Found" :: Text)
         Just v  -> pure v
@@ -105,7 +118,7 @@ getAppConfigR :: AppIdentifier -> Handler TypedContent
 getAppConfigR appId = do
     appSettings <- appSettings <$> getYesod
     let appsDir   = (</> "apps") . resourcesDir $ appSettings
-    let appMgrDir = staticBinDir $ appSettings
+    let appMgrDir = staticBinDir appSettings
     av <- getVersionFromQuery appsDir appExt >>= \case
         Nothing -> sendResponseStatus status400 ("Specified App Version Not Found" :: Text)
         Just v  -> pure v

src/Lib/Registry.hs

@@ -37,6 +37,11 @@ getAvailableAppVersions rootDirectory ext@(Extension appId) = do
         getSubDirectories path = (fmap (fromRight []) . try @SomeException $ listDirectory path)
             >>= filterM (doesDirectoryExist . (path </>))
 
+getMostRecentAppVersion :: KnownSymbol a => FilePath -> Extension a -> IO (Maybe RegisteredAppVersion)
+getMostRecentAppVersion rootDirectory ext = do
+    allVersions <- liftIO $ getAvailableAppVersions rootDirectory ext
+    pure $ head $ sortOn (fst . unRegisteredAppVersion) allVersions
+
 -- /root/appId/version/appId.ext
 getVersionedFileFromDir :: KnownSymbol a => FilePath -> Extension a -> Version -> IO (Maybe FilePath)
 getVersionedFileFromDir rootDirectory ext@(Extension appId) v =

src/Lib/Types/AppIndex.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TemplateHaskell #-}
 module Lib.Types.AppIndex where
@@ -11,6 +12,8 @@ import qualified Data.List.NonEmpty            as NE
 
 import           Lib.Types.Emver
 import           Orphans.Emver                  ( )
+import           System.Directory
+import           Lib.Registry
 
 type AppIdentifier = Text
 
@@ -50,6 +53,7 @@ data StoreApp = StoreApp
     , storeAppDescLong    :: Text
     , storeAppVersionInfo :: NonEmpty VersionInfo
     , storeAppIconType    :: Text
+    , storeAppTimestamp   :: Maybe UTCTime
     }
     deriving Show
 
@@ -59,6 +63,7 @@ instance ToJSON StoreApp where
         , "icon-type" .= storeAppIconType
         , "description" .= object ["short" .= storeAppDescShort, "long" .= storeAppDescLong]
         , "version-info" .= storeAppVersionInfo
+        , "timestamp" .= storeAppTimestamp
         ]
 
 newtype AppManifest = AppManifest { unAppManifest :: HM.HashMap AppIdentifier StoreApp}
@@ -76,7 +81,8 @@ instance FromJSON AppManifest where
             storeAppVersionInfo <- config .: "version-info" >>= \case
                 []       -> fail "No Valid Version Info"
                 (x : xs) -> pure $ x :| xs
-            return $ (appId, StoreApp { .. })
+            storeAppTimestamp   <- config .:? "timestamp"
+            pure (appId, StoreApp { .. })
         return $ AppManifest (HM.fromList apps)
 instance ToJSON AppManifest where
     toJSON = toJSON . unAppManifest
@@ -91,3 +97,11 @@ filterOsRecommended :: Version -> StoreApp -> Maybe StoreApp
 filterOsRecommended av sa = case NE.filter ((av <||) . versionInfoOsRecommended) (storeAppVersionInfo sa) of
     []       -> Nothing
     (x : xs) -> Just $ sa { storeAppVersionInfo = x :| xs }
+
+addFileTimestamp :: KnownSymbol a => FilePath -> Extension a -> StoreApp -> Version -> IO (Maybe StoreApp)
+addFileTimestamp appDir ext service v = do
+    getVersionedFileFromDir appDir ext v >>= \case
+                Nothing -> pure Nothing
+                Just file -> do
+                    time <- getModificationTime file
+                    pure $ Just service {storeAppTimestamp = Just time }