Remove Configurator dependency

Signed-off-by: Jan Hamal Dvořák <mordae@anilinux.org>

hikaru.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: e297323a7b6cecac97f8dd18ae01703782f331a12328a6934ad0a62d7cb0daf3
+-- hash: 5ac50160b1396ef3e336b16f172ed703e020f37d729d4384049493c620bd5167
 
 name:           hikaru
 version:        0.1.0.0
@@ -55,7 +55,6 @@ library
     , binary >=0.8 && <0.9
     , bytestring >=0.10 && <0.11
     , case-insensitive >=1.2 && <1.3
-    , configurator >=0.3 && <0.4
     , containers >=0.6 && <0.7
     , cookie >=0.4 && <0.5
     , cryptonite >=0.26 && <0.27
@@ -94,7 +93,6 @@ test-suite spec
     , binary >=0.8 && <0.9
     , bytestring >=0.10 && <0.11
     , case-insensitive >=1.2 && <1.3
-    , configurator >=0.3 && <0.4
     , containers >=0.6 && <0.7
     , cookie >=0.4 && <0.5
     , cryptonite >=0.26 && <0.27

lib/Hikaru/Action.hs

@@ -89,6 +89,8 @@ module Hikaru.Action
   , dropCaches
 
   -- ** Configuration
+  , updateConfig
+  , updateConfigFromEnv
   , getConfigMaybe
   , getConfigDefault
 
@@ -108,8 +110,6 @@ where
 
   import qualified Data.ByteString as BS
   import qualified Data.ByteString.Lazy as LBS
-  import qualified Data.Configurator as Cfg
-  import qualified Data.Configurator.Types as Cfg
   import qualified Data.Map.Strict as Map
   import qualified Data.Text.Lazy as LT
   import qualified Network.Wai.Parse as Parse
@@ -128,6 +128,7 @@ where
   import Network.HTTP.Types.Method
   import Network.HTTP.Types.Status
   import Network.Wai
+  import System.Environment
   import System.IO.Unsafe
   import Web.Cookie
 
@@ -194,7 +195,7 @@ where
   data ActionEnv
     = ActionEnv
       { aeRequest      :: Request
-      , aeConfig       :: Cfg.Config
+      , aeConfig       :: IORef (Map.Map Text String)
       , aeBody         :: IORef RequestBody
       , aeRespStatus   :: IORef Status
       , aeRespHeaders  :: IORef ResponseHeaders
@@ -264,10 +265,10 @@ where
   -- |
   -- Create the initial action environment from the 'Request'.
   --
-  makeActionEnv :: Cfg.Config -> Request -> IO ActionEnv
-  makeActionEnv cfg req =
+  makeActionEnv :: Request -> IO ActionEnv
+  makeActionEnv req =
     ActionEnv <$> pure req
-              <*> pure cfg
+              <*> newIORef Map.empty
               <*> newIORef BodyUnparsed
               <*> newIORef status200
               <*> newIORef []
@@ -1095,24 +1096,42 @@ where
   -- Configuration -----------------------------------------------------------
 
 
+  -- |
+  -- Update configuration using supplied key-value pairs.
+  --
+  -- Request starts with an empty configuration.
+  --
+  updateConfig :: (MonadAction m) => [(Text, String)] -> m ()
+  updateConfig = modifyActionField aeConfig . Map.union . Map.fromList
+
+
+  -- |
+  -- Update configuration using the program environment.
+  --
+  updateConfigFromEnv :: (MonadAction m) => m ()
+  updateConfigFromEnv = do
+    env <- liftIO $ getEnvironment
+
+    let conv (k, v) = (cs k, v)
+     in updateConfig (map conv env)
+
+
   -- |
   -- Lookup a configuration value.
   --
-  getConfigMaybe :: (MonadAction m, Cfg.Configured a) => Text -> m (Maybe a)
+  getConfigMaybe :: (MonadAction m, Read a) => Text -> m (Maybe a)
   getConfigMaybe name = do
-    cfg <- aeConfig <$> getActionEnv
-    liftIO do
-      Cfg.lookup cfg name
+    cfg <- getActionField aeConfig
+    return $ readMaybe =<< Map.lookup name cfg
 
 
   -- |
   -- Lookup a configuration value with a fallback to return if not found.
   --
-  getConfigDefault :: (MonadAction m, Cfg.Configured a) => Text -> a -> m a
+  getConfigDefault :: (MonadAction m, Read a) => Text -> a -> m a
   getConfigDefault name value = do
-    cfg <- aeConfig <$> getActionEnv
-    liftIO do
-      Cfg.lookupDefault value cfg name
+    cfg <- getActionField aeConfig
+    return $ fromMaybe value $ readMaybe =<< Map.lookup name cfg
 
 
   -- Finalizing --------------------------------------------------------------

lib/Hikaru/CSRF.hs

@@ -29,10 +29,12 @@ where
   -- |
   -- Generate an anti-CSRF token to be used with forms.
   --
+  -- Uses the @CSRF_SECRET@ configuration key.
+  --
   generateToken :: (MonadAction m) => m Text
   generateToken = do
     now    <- getTimestamp
-    secret <- getConfigDefault "csrf.secret" ""
+    secret <- getConfigDefault "CSRF_SECRET" ""
 
     let signature = sign now secret
      in return $ mconcat [ show now, ":", signature ]
@@ -41,6 +43,9 @@ where
   -- |
   -- Verify that the anti-CSRF token is currently valid.
   --
+  -- Uses the @CSRF_SECRET@ and @CSRF_VALIDITY@ configuration keys.
+  -- Valididy defaults to 86400 seconds (24 hours).
+  --
   isTokenValid :: (MonadAction m) => Text -> m Bool
   isTokenValid token = do
     case splitOn ":" token of
@@ -48,8 +53,8 @@ where
         case readMaybe (cs time) of
           Just (timestamp :: Int64) -> do
             now    <- getTimestamp
-            valid  <- getConfigDefault "csrf.validity" 86400
-            secret <- getConfigDefault "csrf.secret" ""
+            valid  <- getConfigDefault "CSRF_VALIDITY" 86400
+            secret <- getConfigDefault "CSRF_SECRET" ""
 
             if timestamp + valid >= now
                then return (sign timestamp secret == signature)

package.yaml

@@ -49,7 +49,6 @@ dependencies:
   - binary             >= 0.8  && <0.9
   - bytestring         >= 0.10 && <0.11
   - case-insensitive   >= 1.2  && <1.3
-  - configurator       >= 0.3  && <0.4
   - containers         >= 0.6  && <0.7
   - cookie             >= 0.4  && <0.5
   - cryptonite         >= 0.26 && <0.27