Config.purs (6810B)
1 module Config where 2 3 import Prelude 4 5 import Data.Argonaut.Core (Json) 6 import Data.Function.Uncurried (Fn3, runFn3) 7 import Data.Argonaut (decodeJson, (.:), (.:?)) 8 import Data.Either (Either(..)) 9 import Data.Int (fromString) as Data.Int 10 import Data.Maybe (Maybe(..), fromMaybe, isJust, isNothing) 11 import Data.String (joinWith) 12 import Data.Traversable (traverse) 13 import Effect (Effect) 14 import Control.Monad.Error.Class (throwError) 15 import Effect.Aff (Aff, makeAff, nonCanceler) 16 import Effect.Class (liftEffect) 17 import Effect.Exception (error) 18 import Node.Process (cwd, lookupEnv) 19 20 type UserConfig = 21 { listenbrainzUser :: Maybe String 22 , lastfmUser :: Maybe String 23 , lastfmApiKey :: Maybe String 24 , discogsToken :: Maybe String 25 , cosineApiKey :: Maybe String 26 , databaseFile :: String 27 , s3Bucket :: Maybe String 28 , s3Region :: String 29 , awsAccessKeyId :: Maybe String 30 , awsSecretAccessKey :: Maybe String 31 , awsEndpointUrl :: Maybe String 32 , awsS3AddressingStyle :: Maybe String 33 , coverCacheEnabled :: Boolean 34 , backupEnabled :: Boolean 35 , backupIntervalHours :: Int 36 } 37 38 type UserEntry = 39 { slug :: String 40 , name :: Maybe String 41 , config :: UserConfig 42 } 43 44 type AppConfig = 45 { port :: Int 46 , host :: String 47 , metricsEnabled :: Boolean 48 , corsOrigin :: String 49 , users :: Array UserEntry 50 } 51 52 type S3Config = 53 { bucket :: Maybe String 54 , region :: String 55 , accessKeyId :: Maybe String 56 , secretAccessKey :: Maybe String 57 , endpointUrl :: Maybe String 58 , addressingStyle :: Maybe String 59 } 60 61 s3ConfigFromUser :: UserConfig -> S3Config 62 s3ConfigFromUser cfg = 63 { bucket: cfg.s3Bucket 64 , region: cfg.s3Region 65 , accessKeyId: cfg.awsAccessKeyId 66 , secretAccessKey: cfg.awsSecretAccessKey 67 , endpointUrl: cfg.awsEndpointUrl 68 , addressingStyle: cfg.awsS3AddressingStyle 69 } 70 71 foreign import loadConfigImpl 72 :: Fn3 String (String -> Effect Unit) (Json -> Effect Unit) (Effect Unit) 73 74 loadConfig :: String -> Aff AppConfig 75 loadConfig path = do 76 json <- makeAff \cb -> 77 runFn3 loadConfigImpl path 78 (\msg -> cb (Left (error msg))) 79 (\j -> cb (Right j)) 80 *> pure nonCanceler 81 rawUsers <- case decodeUsersJson json of 82 Left msg -> throwError (error msg) 83 Right users -> pure users 84 portStr <- liftEffect $ lookupEnv "PORT" 85 hostStr <- liftEffect $ lookupEnv "HOST" 86 lastfmApiKey <- liftEffect $ lookupEnv "LASTFM_API_KEY" 87 discogsToken <- liftEffect $ lookupEnv "DISCOGS_TOKEN" 88 cosineApiKey <- liftEffect $ lookupEnv "COSINE_API_KEY" 89 s3Bucket <- liftEffect $ lookupEnv "S3_BUCKET" 90 s3Region <- liftEffect $ map (fromMaybe "us-east-1") $ lookupEnv "S3_REGION" 91 awsAccessKeyId <- liftEffect $ lookupEnv "AWS_ACCESS_KEY_ID" 92 awsSecretAccessKey <- liftEffect $ lookupEnv "AWS_SECRET_ACCESS_KEY" 93 awsEndpointUrl <- liftEffect $ lookupEnv "AWS_ENDPOINT_URL" 94 awsS3AddressingStyle <- liftEffect $ lookupEnv "AWS_S3_ADDRESSING_STYLE" 95 databasePath <- liftEffect $ lookupEnv "DATABASE_PATH" 96 metricsEnabledStr <- liftEffect $ lookupEnv "METRICS_ENABLED" 97 corsOriginStr <- liftEffect $ lookupEnv "CORS_ORIGIN" 98 defaultPath <- liftEffect cwd 99 let 100 resolvePath file = case databasePath of 101 Nothing -> defaultPath <> "/" <> file 102 Just dir -> dir <> "/" <> file 103 fillCreds cfg = cfg 104 { lastfmApiKey = lastfmApiKey 105 , discogsToken = discogsToken 106 , cosineApiKey = cosineApiKey 107 , s3Bucket = s3Bucket 108 , s3Region = s3Region 109 , awsAccessKeyId = awsAccessKeyId 110 , awsSecretAccessKey = awsSecretAccessKey 111 , awsEndpointUrl = awsEndpointUrl 112 , awsS3AddressingStyle = awsS3AddressingStyle 113 , databaseFile = resolvePath cfg.databaseFile 114 } 115 let 116 port = fromMaybe 8000 (portStr >>= Data.Int.fromString) 117 host = fromMaybe "127.0.0.1" hostStr 118 metricsEnabled = metricsEnabledStr == Just "true" 119 corsOrigin = fromMaybe "*" corsOriginStr 120 fullConfig = { port, host, metricsEnabled, corsOrigin, users: map (\u -> u { config = fillCreds u.config }) rawUsers } 121 case validateConfig fullConfig of 122 Left msg -> throwError (error msg) 123 Right cfg -> pure cfg 124 125 validateConfig :: AppConfig -> Either String AppConfig 126 validateConfig cfg = do 127 _ <- traverse validateUserEntry cfg.users 128 pure cfg 129 130 validateUserEntry :: UserEntry -> Either String UserEntry 131 validateUserEntry entry = 132 let 133 c = entry.config 134 label = if entry.slug == "" then "root" else entry.slug 135 lfmMissing = 136 if isJust c.lastfmUser && isNothing c.lastfmApiKey then [ "LASTFM_API_KEY" ] 137 else [] 138 s3Missing = 139 if c.coverCacheEnabled || c.backupEnabled then 140 (if isNothing c.s3Bucket then [ "S3_BUCKET" ] else []) 141 <> (if isNothing c.awsAccessKeyId then [ "AWS_ACCESS_KEY_ID" ] else []) 142 <> (if isNothing c.awsSecretAccessKey then [ "AWS_SECRET_ACCESS_KEY" ] else []) 143 <> (if isNothing c.awsEndpointUrl then [ "AWS_ENDPOINT_URL" ] else []) 144 else [] 145 missing = lfmMissing <> s3Missing 146 in 147 if missing == [] then Right entry 148 else Left ("User '" <> label <> "': missing required env vars: " <> joinWith ", " missing) 149 150 mapLeft :: forall a b c. (a -> c) -> Either a b -> Either c b 151 mapLeft f (Left a) = Left (f a) 152 mapLeft _ (Right b) = Right b 153 154 decodeUsersJson :: Json -> Either String (Array UserEntry) 155 decodeUsersJson json = do 156 obj <- mapLeft show $ decodeJson json 157 usersArr <- mapLeft show (obj .: "users" :: Either _ (Array Json)) 158 traverse decodeUserEntry usersArr 159 160 decodeUserEntry :: Json -> Either String UserEntry 161 decodeUserEntry json = do 162 obj <- mapLeft show $ decodeJson json 163 slug <- mapLeft show $ obj .: "slug" 164 name <- mapLeft show $ obj .:? "name" 165 configJson <- mapLeft show (obj .: "config" :: Either _ Json) 166 config <- decodeUserConfig configJson 167 pure { slug, name, config } 168 169 -- Decodes only the non-sensitive, per-user fields from users.json. 170 -- Shared credentials are injected from environment variables in loadConfig. 171 decodeUserConfig :: Json -> Either String UserConfig 172 decodeUserConfig json = do 173 obj <- mapLeft show $ decodeJson json 174 listenbrainzUser <- mapLeft show $ obj .:? "listenbrainzUser" 175 lastfmUser <- mapLeft show $ obj .:? "lastfmUser" 176 databaseFile <- mapLeft show $ obj .: "databaseFile" 177 coverCacheEnabled <- mapLeft show $ obj .: "coverCacheEnabled" 178 backupEnabled <- mapLeft show $ obj .: "backupEnabled" 179 backupIntervalHours <- mapLeft show $ obj .: "backupIntervalHours" 180 pure 181 { listenbrainzUser 182 , lastfmUser 183 , lastfmApiKey: Nothing 184 , discogsToken: Nothing 185 , cosineApiKey: Nothing 186 , databaseFile 187 , s3Bucket: Nothing 188 , s3Region: "us-east-1" 189 , awsAccessKeyId: Nothing 190 , awsSecretAccessKey: Nothing 191 , awsEndpointUrl: Nothing 192 , awsS3AddressingStyle: Nothing 193 , coverCacheEnabled 194 , backupEnabled 195 , backupIntervalHours 196 }