Merge branch 'digitallyinduced:master' into master

Guide/database-migrations.markdown

@@ -73,6 +73,20 @@ migrate
 
 A good value for `MINIMUM_REVISION` is typically the unix timestamp of the time when the database was initially created.
 
+
+### IHP MIGRATIONS DIR
+
+In production when running the migrations binary it is sometimes convenient to have all your Migrations in a non-standard place:
+e.g. if you need to push migrations onto production server without rebuilding the application. There is an Environment variable
+`IHP_MIGRATION_DIR` to accomplish this.
+
+```
+IHP_MIGRATION_DIR=path/to/my/migration/dir
+```
+
+This can be set in the environment attribute set of your IHP app flake.
+
+
 ## Common Issues
 
 ### ALTER TYPE ... ADD cannot run inside a transaction block

Guide/database.markdown

@@ -20,7 +20,7 @@ When the development server is running, you can connect to it via `postgresql://
 
 When the development server is running, you can use your favorite UI tool (e.g. [TablePlus](https://tableplus.com/)) that allows connecting to Postgres. To do that you would need the following credentials:
 
-Database Host: This is the application root + "/build/db". Use this command on terminal form the root of you app and copy the output:
+Database Host: This is the application root + "/build/db". Use this command on terminal from the root of your app and copy the output:
 ```
 echo `pwd`/build/db
 ```

Guide/jobs.markdown

@@ -44,11 +44,25 @@ instance Job EmailCustomersJob where
 
 ### Running the job
 
-IHP watches the job table in the database for any new records and automatically runs the job asynchronously when a new job is added. So to run a job, simply create a new record:
+IHP watches the job table in the database for any new records and automatically runs the job asynchronously when a new job is added. There are two ways to run a job:
+
+1. Run immediately (as soon as a job worker is available):
 
 ```haskell
 newRecord @EmailCustomersJob |> create
 ```
+2. Schedule for future execution:
+
+```haskell
+import Data.Time.Clock (addUTCTime, getCurrentTime, nominalDay)
+
+now <- getCurrentTime
+newRecord @EmailCustomersJob 
+    |> set #runAt (addUTCTime nominalDay now)  -- Schedule 24 hours in the future
+    |> create
+```
+
+The `runAt` field determines when the job should be executed. If not set, the job runs immediately. When set, IHP polls for scheduled jobs approximately every minute and executes any jobs whose `runAt` time has passed.
 
 This can be done in a controller action or in a script as will be shown below.
 

IHP/DataSync/ControllerImpl.hs

@@ -187,6 +187,49 @@ buildMessageHandler ensureRLSEnabled installTableChangeTriggers sendJSON handleC
 
                     MVar.takeMVar close
 
+            handleMessage CreateCountSubscription { query, requestId } = do
+                ensureBelowSubscriptionsLimit
+
+                tableNameRLS <- ensureRLSEnabled query.table
+
+                subscriptionId <- UUID.nextRandom
+
+                -- Allocate the close handle as early as possible
+                -- to make DeleteDataSubscription calls succeed even when the CountSubscription is
+                -- not fully set up yet
+                close <- MVar.newEmptyMVar
+                atomicModifyIORef'' ?state (\state -> state |> modify #subscriptions (HashMap.insert subscriptionId close))
+
+                let (theQuery, theParams) = compileQueryWithRenamer (renamer query.table) query
+
+                let countQuery = "SELECT COUNT(*) FROM (" <> theQuery <> ") AS _inner"
+
+                let
+                    unpackResult :: [(Only Int)] -> Int
+                    unpackResult [(Only value)] = value
+                    unpackResult otherwise = error "DataSync.unpackResult: Expected INT, but got something else"
+
+                count <- unpackResult <$> sqlQueryWithRLS countQuery theParams
+                countRef <- newIORef count
+
+                installTableChangeTriggers tableNameRLS
+
+                let
+                    callback :: ChangeNotifications.ChangeNotification -> IO ()
+                    callback _ = do
+                        newCount <- unpackResult <$> sqlQueryWithRLS countQuery theParams
+                        lastCount <- readIORef countRef
+
+                        when (newCount /= count) (sendJSON DidChangeCount { subscriptionId, count = newCount })
+
+                let subscribe = PGListener.subscribeJSON (ChangeNotifications.channelName tableNameRLS) callback pgListener
+                let unsubscribe subscription = PGListener.unsubscribe subscription pgListener
+
+                Exception.bracket subscribe unsubscribe \channelSubscription -> do
+                    sendJSON DidCreateCountSubscription { subscriptionId, requestId, count }
+
+                    MVar.takeMVar close
+
             handleMessage DeleteDataSubscription { requestId, subscriptionId } = do
                 DataSyncReady { subscriptions } <- getState
                 case HashMap.lookup subscriptionId subscriptions of

IHP/DataSync/REST/Controller.hs

@@ -203,7 +203,7 @@ aesonValueToPostgresValue (Number value) = case Scientific.floatingOrInteger val
     Left (floating :: Double) -> PG.toField floating
     Right (integer :: Integer) -> PG.toField integer
 aesonValueToPostgresValue Data.Aeson.Null = PG.toField PG.Null
-aesonValueToPostgresValue (Data.Aeson.Array values) = PG.toField (PG.PGArray (Vector.toList values))
+aesonValueToPostgresValue (Data.Aeson.Array values) = PG.toField (PG.PGArray (map aesonValueToPostgresValue (Vector.toList values)))
 aesonValueToPostgresValue object@(Object values) =
     let
         tryDecodeAsPoint :: Maybe Point

IHP/DataSync/Types.hs

@@ -10,6 +10,7 @@ import Control.Concurrent.MVar as MVar
 data DataSyncMessage
     = DataSyncQuery { query :: !DynamicSQLQuery, requestId :: !Int, transactionId :: !(Maybe UUID) }
     | CreateDataSubscription { query :: !DynamicSQLQuery, requestId :: !Int }
+    | CreateCountSubscription { query :: !DynamicSQLQuery, requestId :: !Int }
     | DeleteDataSubscription { subscriptionId :: !UUID, requestId :: !Int }
     | CreateRecordMessage { table :: !Text, record :: !(HashMap Text Value), requestId :: !Int, transactionId :: !(Maybe UUID) }
     | CreateRecordsMessage { table :: !Text, records :: ![HashMap Text Value], requestId :: !Int, transactionId :: !(Maybe UUID) }
@@ -31,10 +32,12 @@ data DataSyncResponse
     | DataSyncError { requestId :: !Int, errorMessage :: !Text }
     | FailedToDecodeMessageError { errorMessage :: !Text }
     | DidCreateDataSubscription { requestId :: !Int, subscriptionId :: !UUID, result :: ![[Field]] }
+    | DidCreateCountSubscription { requestId :: !Int, subscriptionId :: !UUID, count :: !Int }
     | DidDeleteDataSubscription { requestId :: !Int, subscriptionId :: !UUID }
     | DidInsert { subscriptionId :: !UUID, record :: ![Field] }
     | DidUpdate { subscriptionId :: !UUID, id :: UUID, changeSet :: !Value }
     | DidDelete { subscriptionId :: !UUID, id :: !UUID }
+    | DidChangeCount { subscriptionId :: !UUID, count :: !Int }
     | DidCreateRecord { requestId :: !Int, record :: ![Field] } -- ^ Response to 'CreateRecordMessage'
     | DidCreateRecords { requestId :: !Int, records :: ![[Field]] } -- ^ Response to 'CreateRecordsMessage'
     | DidUpdateRecord { requestId :: !Int, record :: ![Field] } -- ^ Response to 'UpdateRecordMessage'

IHP/FileStorage/ControllerFunctions.hs

@@ -40,7 +40,7 @@ import qualified System.Directory as Directory
 import qualified Control.Exception as Exception
 import qualified Network.Wreq as Wreq
 import Control.Lens hiding ((|>), set)
-import IHP.FileStorage.MimeTypes
+import qualified Network.Mime as Mime
 
 -- | Uploads a file to a directory in the storage
 --
@@ -179,7 +179,7 @@ storeFileFromUrl url options = do
 --
 storeFileFromPath :: (?context :: context, ConfigProvider context) => Text -> StoreFileOptions -> IO StoredFile
 storeFileFromPath path options = do
-    let fileContentType = path |> guessMimeType |> cs
+    let fileContentType = Mime.defaultMimeLookup (cs path)
 
     fileContent <- LBS.readFile (cs path)
     let file = Wai.FileInfo