syncthing-hs 0.1.2.0 → 0.2.0.0

raw patch · 26 files changed

+701/−396 lines, 26 filesdep +data-defaultdep +http-typesdep +scientificPVP ok

version bump matches the API change (PVP)

Dependencies added: data-default, http-types, scientific, vector

API changes (from Hackage documentation)

Files

• Network/Syncthing.hs +4/−4
• Network/Syncthing/Get.hs +76/−52
• Network/Syncthing/Internal/Monad.hs +8/−2
• Network/Syncthing/Internal/Request.hs +2/−2
• Network/Syncthing/Internal/Types.hs +4/−0
• Network/Syncthing/Internal/Utils.hs +12/−18
• Network/Syncthing/Post.hs +42/−42
• Network/Syncthing/Types.hs +6/−1
• Network/Syncthing/Types/Config.hs +131/−116
• Network/Syncthing/Types/Connection.hs +20/−6
• Network/Syncthing/Types/DBFile.hs +29/−0
• Network/Syncthing/Types/DeviceInfo.hs +24/−0
• Network/Syncthing/Types/DirTree.hs +17/−16
• Network/Syncthing/Types/Error.hs +2/−2
• Network/Syncthing/Types/FileInfo.hs +39/−0
• Network/Syncthing/Types/FolderInfo.hs +38/−0
• Network/Syncthing/Types/Need.hs +8/−30
• Network/Syncthing/Types/System.hs +6/−0
• README.md +2/−2
• changelog.md +5/−0
• syncthing-hs.cabal +12/−1
• tests/Properties/JsonArbitrary.hs +8/−1
• tests/Properties/JsonInstances.hs +51/−18
• tests/Properties/JsonProperties.hs +6/−1
• tests/UnitTests/Errors.hs +94/−31
• tests/UnitTests/Requests.hs +55/−51

@@ -22,9 +22,9 @@ -- @ -- \{\-\# LANGUAGE OverloadedStrings \#\-\} ----- import qualified "Network.Wreq" as Wreq--- import "Control.Monad" ('Control.Monad.liftM2') -- import "Control.Lens" (('Control.Lens.&'), ('Control.Lens..~'), ('Control.Lens.?~'))+-- import "Control.Monad" ('Control.Monad.liftM2')+-- import qualified "Network.Wreq" as Wreq -- import "Network.Syncthing" -- import qualified "Network.Syncthing.Get" as Get --@@ -164,7 +164,7 @@ -- /Example:/ -- -- >>> defaultConfig--- SyncConfig { server = "127.0.0.1:8080", apiKey = Nothing, auth = Nothing, https = False, manager = Left _ }+-- SyncConfig { server = "127.0.0.1:8384", apiKey = Nothing, auth = Nothing, https = False, manager = Left _ } -- -- >>> defaultConfig { server = "192.168.0.10:8080", apiKey = Just "XXXX" } -- SyncConfig { server = "192.168.0.10:8080", apiKey = Just "XXXX", auth = Nothing, https = False, manager = Left _ }@@ -173,7 +173,7 @@ -- SyncConfig { server = "192.168.0.10:8080", apiKey = Just "XXXX", auth = Nothing, https = False, manager = Left _ } defaultConfig :: SyncConfig defaultConfig = SyncConfig {-      server   = "127.0.0.1:8080"+      server   = "127.0.0.1:8384"     , apiKey   = Nothing     , auth     = Nothing     , https    = False

@@ -16,24 +16,34 @@  module Network.Syncthing.Get     (-    -- * Request functions+    -- * System Services       ping     , apiKey     , config-    , completion+    , insync     , connections-    , deviceId     , discovery     , errors+    , sysStatus+    , upgrade+    , version++    -- * Database Services+    , browse+    , completion+    , file     , ignores-    , model     , need+    , dbStatus++    -- * Statistics Services+    , devices+    , folders++    -- * Miscellaneous Services+    , deviceId+    , lang     , report-    , sync-    , system-    , tree-    , upgrade-    , version     ) where  import           Control.Applicative                ((<$>))@@ -50,13 +60,11 @@  -- | Ping the Syncthing server. Returns the string \"pong\". ping :: MonadSync m => SyncM m Text-ping = getPing <$> ping'-  where-    ping' = query $ getRequest { path = "/rest/ping" }+ping = getPing <$> query getRequest { path = "/rest/system/ping" }  -- | Return the current configuration. config :: MonadSync m => SyncM m Config-config = query $ getRequest { path = "/rest/config" }+config = query getRequest { path = "/rest/system/config" }  -- | Get the API Key if available. apiKey :: MonadSync m => SyncM m (Maybe Text)@@ -65,90 +73,106 @@ -- | Return the completion percentage (0 to 100) for a given device and -- folder. completion :: MonadSync m => Device -> FolderName -> SyncM m Int-completion device folder = getCompletion <$> completion'-  where-    completion' = query $ getRequest { path   = "/rest/completion"-                                     , params = [ ("device", device)-                                                , ("folder", folder) ]-                                     }+completion device folder = +    getCompletion <$> query getRequest { path   = "/rest/db/completion"+                                       , params = [ ("device", device)+                                                  , ("folder", folder) ]+                                       }  -- | Get the list of current connections and some metadata associated -- with the connection/peer.-connections :: MonadSync m => SyncM m (M.Map Device Connection)-connections = query $ getRequest { path = "/rest/connections" }+connections :: MonadSync m => SyncM m Connections+connections = query getRequest { path = "/rest/system/connections" } +-- | Returns most data available about a given file, including version and+-- availability.+file :: MonadSync m => FolderName -> Path -> SyncM m DBFile+file folder filename = query getRequest { path   = "/rest/db/file"+                                        , params = [ ("folder", folder)+                                                   , ("file", filename) ]+                                        }+ -- | Verifiy and format a device ID. Return either a valid device ID in -- modern format, or an error. deviceId :: MonadSync m => Device -> SyncM m Device deviceId = deviceId' >=> either (liftLeft . InvalidDeviceId) liftRight   where     deviceId' :: MonadSync m => Device -> SyncM m (Either DeviceError Device)-    deviceId' device = query $ getRequest { path   = "/rest/deviceid"-                                          , params = [("id", device)]-                                          }+    deviceId' device = query getRequest { path   = "/rest/svc/deviceid"+                                        , params = [("id", device)]+                                        } +-- | Returns general statistics about devices.+devices :: MonadSync m => SyncM m (M.Map Device DeviceInfo)+devices = query getRequest { path = "/rest/stats/device" }+ -- | Fetch the contents of the local discovery cache. discovery :: MonadSync m => SyncM m (M.Map Device [CacheEntry])-discovery = query $ getRequest { path = "/rest/discovery" }+discovery = query getRequest { path = "/rest/system/discovery" }  -- | Get the list of recent errors. errors :: MonadSync m => SyncM m [Error]-errors = getErrors <$> errors'-  where-    errors' = query $ getRequest { path = "/rest/errors" }+errors = getErrors <$> query getRequest { path = "/rest/system/error" }  -- | Fetch the ignores list. ignores :: MonadSync m => FolderName -> SyncM m Ignore-ignores folder = query $ getRequest { path   = "/rest/ignores"-                                    , params = [("folder", folder)]-                                    }---- | Get information about the current status of a folder.-model :: MonadSync m => FolderName -> SyncM m Model-model folder = query $ getRequest { path   = "/rest/model"+ignores folder = query getRequest { path   = "/rest/db/ignores"                                   , params = [("folder", folder)]                                   } +-- | Get information about the current status of a folder.+dbStatus :: MonadSync m => FolderName -> SyncM m Model+dbStatus folder = query getRequest { path   = "/rest/db/status"+                                   , params = [("folder", folder)]+                                   }+ -- | Get lists of files which are needed by this device in order for it -- to become in sync. need :: MonadSync m => FolderName -> SyncM m Need-need folder = query $ getRequest { path   = "/rest/need"-                                 , params = [("folder", folder)]-                                 }+need folder = query getRequest { path   = "/rest/db/need"+                               , params = [("folder", folder)]+                               }  -- | Returns the data sent in the anonymous usage report. report :: MonadSync m => SyncM m UsageReport-report = query $ getRequest { path   = "/rest/report" }+report = query getRequest { path   = "/rest/svc/report" }  -- | Determine whether the config is in sync.-sync :: MonadSync m => SyncM m Bool-sync = getSync <$> sync'-  where-    sync' = query $ getRequest { path = "/rest/config/sync" }+insync :: MonadSync m => SyncM m Bool+insync = getSync <$> query getRequest { path = "/rest/system/config/insync" }  -- | Returns information about current system status and resource usage.-system :: MonadSync m => SyncM m System-system = query $ getRequest { path = "/rest/system" }+sysStatus :: MonadSync m => SyncM m System+sysStatus = query getRequest { path = "/rest/system/status" }  -- | Get the directory tree of the global model.-tree :: MonadSync m +browse :: MonadSync m      => FolderName -- ^ root folder     -> Maybe Path -- ^ defines a prefix within the tree where to start building the structure     -> Maybe Int  -- ^ defines how deep within the tree we want to dwell down (0 based, defaults to unlimited depth)       -> SyncM m (Maybe DirTree)-tree folder prefix levels  = -    queryMaybe $ getRequest { path   = "/rest/tree"-                            , params = [("folder", folder)] ++ optionals-                            }+browse folder prefix levels  = +    queryMaybe getRequest { path   = "/rest/db/browse"+                          , params = [("folder", folder)] ++ optionals+                          }   where      optionals  = catMaybes [("prefix",) <$> prefix, ("levels",) <$> levelsText]     levelsText = pack . show <$> levels  -- | Check for a possible upgrade. upgrade :: MonadSync m => SyncM m Upgrade-upgrade = query $ getRequest { path   = "/rest/upgrade" }+upgrade = query getRequest { path   = "/rest/system/upgrade" }  -- | Get the current syncthing version information. version :: MonadSync m => SyncM m Version-version = query $ getRequest { path = "/rest/version" }+version = query getRequest { path = "/rest/system/version" }++-- | Returns a list of canonicalized localization codes, as picked up from+-- the Accept-Language header sent by the browser.+lang :: MonadSync m => SyncM m [Text]+lang = query getRequest { path = "/rest/svc/lang" }++-- | Returns general statistics about folders. +folders :: MonadSync m => SyncM m (M.Map FolderName FolderInfo)+folders = query getRequest { path = "/rest/stats/folder" } 

@@ -6,6 +6,7 @@     ( SyncResult     , SyncM(..)     , MonadSync(..)+    , runSyncM     , syncthingM     , liftEither     , liftReader@@ -45,10 +46,15 @@     getMethod  o s   = (^. W.responseBody) <$> W.getWith  o s     postMethod o s p = (^. W.responseBody) <$> W.postWith o s p --- | Run Syncthing requests.+-- | Run Syncthing requests without error handling.+runSyncM :: SyncConfig -> SyncM m a -> m (SyncResult a)+runSyncM config action =+    runReaderT (runEitherT $ runSyncthing action) config ++-- | Run Syncthing requests with error handling. syncthingM :: MonadCatch m => SyncConfig -> SyncM m a -> m (SyncResult a) syncthingM config action =-    runReaderT (runEitherT $ runSyncthing action) config `catch` syncErrHandler+    runSyncM config action `catch` syncErrHandler  liftEither :: Monad m => EitherT SyncError (ReaderT SyncConfig m) a -> SyncM m a liftEither = SyncM

@@ -88,14 +88,14 @@  getRequest :: SyncRequest getRequest = SyncRequest {-      path   = "/rest/ping"+      path   = "/rest/system/ping"     , method = get     , params = []     }  postRequest :: SyncRequest postRequest = SyncRequest {-      path   = "/rest/ping"+      path   = "/rest/system/ping"     , method = post ()     , params = []     }

@@ -12,7 +12,11 @@ import           Network.Syncthing.Types.Config      as Ty import           Network.Syncthing.Types.Connection  as Ty import           Network.Syncthing.Types.DeviceId    as Ty+import           Network.Syncthing.Types.DeviceInfo  as Ty import           Network.Syncthing.Types.DirTree     as Ty+import           Network.Syncthing.Types.DBFile      as Ty+import           Network.Syncthing.Types.FileInfo    as Ty+import           Network.Syncthing.Types.FolderInfo  as Ty import           Network.Syncthing.Types.Error       as Ty import           Network.Syncthing.Types.Ignore      as Ty import           Network.Syncthing.Types.Model       as Ty

@@ -8,31 +8,25 @@     , fromUTC     ) where -import           Control.Applicative                     ((<$>))-import           Control.Arrow                           (second, (***))-import           Data.Maybe                              (fromMaybe)-import qualified Data.Text                               as T-import           Data.Time.Clock                         (UTCTime)-import           Data.Time.Format                        (formatTime, parseTime)-import           System.Locale                           (defaultTimeLocale)-import           Text.Regex.Posix                        ((=~))+import           Control.Applicative            ((<$>))+import           Data.Maybe                     (fromMaybe)+import qualified Data.Text                      as T+import           Data.Time.Clock                (UTCTime)+import           Data.Time.Format               (formatTime, parseTime)+import           System.Locale                  (defaultTimeLocale)+import           Text.Regex.Posix               ((=~))  import           Network.Syncthing.Types.Common   -- | Parse server string (SERVER:PORT) into an address type. parseAddr :: Server -> Addr-parseAddr s =-    if serverString =~ ("^[^:]+:[0-9]+$" :: String)-        then mapAddr . split (== ':') $ serverString-        else (T.pack serverString, Nothing)+parseAddr s = addr (serverString =~ serverPat :: [[String]])   where-    serverString = T.unpack s-    mapAddr :: (String, String) -> Addr-    mapAddr = T.pack *** (Just . read)--split :: (Char -> Bool) -> String -> (String, String)-split p = (second $ drop 1) . break p+    serverString     = T.unpack s+    serverPat        = "^\\[?([^]]+)\\]?:([0-9]+)$" :: String+    addr [[_, h, p]] = (T.pack h, Just $ read p)+    addr _           = (s, Nothing)  -- | Generate server string. encodeAddr :: Addr -> Server

@@ -16,19 +16,21 @@  module Network.Syncthing.Post     (-    -- * Request functions-      ping-    , bump-    , hint-    , sendConfig+    -- * System services+      config+    , discovery+    , ping     , sendError     , clearErrors-    , sendIgnores-    , scanFolder     , reset     , restart     , shutdown     , upgrade++    -- * Database Services+    , ignores+    , prio+    , scan     ) where  import           Control.Applicative                ((<$>))@@ -47,77 +49,75 @@  -- | Ping the Syncthing server. Returns the string \"pong\". ping :: MonadSync m => SyncM m Text-ping = getPing <$> ping'-  where-    ping' = query $ postRequest { path = "/rest/ping" }+ping = getPing <$> query postRequest { path = "/rest/system/ping" }  -- | Move the given file to the top of the download queue.-bump :: MonadSync m => FolderName -> Path -> SyncM m Need-bump folder filePath =-    query $ postRequest { path   = "/rest/bump"-                        , params = [ ("folder", folder) , ("file", filePath) ]-                        }+prio :: MonadSync m => FolderName -> Path -> SyncM m Need+prio folder filePath =+    query postRequest { path   = "/rest/db/prio"+                      , params = [ ("folder", folder) , ("file", filePath) ]+                      }  -- | Add an entry to the discovery cache.-hint:: MonadSync m => Device -> Server -> SyncM m ()-hint device server=-    send $ postRequest { path   = "/rest/discovery/hint"-                       , params = [("device", device), ("addr", server)]-                       }+discovery :: MonadSync m => Device -> Server -> SyncM m ()+discovery  device server =+    send postRequest { path   = "/rest/system/discovery"+                     , params = [("device", device), ("addr", server)]+                     }  -- | Update the server configuration. The configuration will be saved to -- disk and the configInSync flag set to false.  -- 'Network.Syncthing.Post.restart' Syncthing to activate.-sendConfig :: MonadSync m => Config -> SyncM m ()-sendConfig cfg = send $ postRequest { path   = "/rest/config"-                                    , method = post cfg-                                    }+config :: MonadSync m => Config -> SyncM m ()+config cfg = send postRequest { path   = "/rest/system/config"+                              , method = post cfg+                              }  -- | Register a new error message. sendError :: MonadSync m => Text -> SyncM m ()-sendError msg = send $ postRequest { path   = "/rest/error"-                                   , method = post msg-                                   }+sendError msg = send postRequest { path   = "/rest/system/error"+                                 , method = post msg+                                 }  -- | Remove all recent errors. clearErrors :: MonadSync m => SyncM m ()-clearErrors = send $ postRequest { path = "/rest/error/clear" }+clearErrors = send $ postRequest { path = "/rest/system/error/clear" }  -- | Update the ignores list and echo it back as response.-sendIgnores :: MonadSync m => FolderName -> [Text] -> SyncM m (Maybe [Text])-sendIgnores folder ignores =-    getIgnores <$> query postRequest { path   = "/rest/ignores"+ignores :: MonadSync m => FolderName -> [Text] -> SyncM m (Maybe [Text])+ignores folder ignoresList =+    getIgnores <$> query postRequest { path   = "/rest/db/ignores"                                      , method = post ignoresMap                                      , params = [("folder", folder)]                                      }   where     ignoresMap :: Map.Map Text [Text]-    ignoresMap = Map.singleton "ignore" ignores+    ignoresMap = Map.singleton "ignore" ignoresList  -- | Request rescan of a folder. Restrict the scan to a relative subpath -- within the folder by specifying the optional path parameter.-scanFolder:: MonadSync m => FolderName -> Maybe Path -> SyncM m ()-scanFolder folder subPath =-    send $ postRequest { path   = "/rest/scan"-                       , params = [("folder", folder)]-                                  ++ maybeToList (("sub",) <$> subPath)-                       }+scan:: MonadSync m => FolderName -> Maybe Path -> SyncM m ()+scan folder subPath =+    send postRequest { path   = "/rest/db/scan"+                     , params = [("folder", folder)]+                                ++ maybeToList (("sub",) <$> subPath)+                     }  -- | Restart Syncthing. restart :: MonadSync m => SyncM m SystemMsg-restart = query postRequest { path = "/rest/restart" }+restart = query postRequest { path = "/rest/system/restart" }  -- | Shutdown Syncthing. shutdown :: MonadSync m => SyncM m SystemMsg-shutdown = query postRequest { path = "/rest/shutdown" }+shutdown = query postRequest { path = "/rest/system/shutdown" }  -- | Reset Syncthing by renaming all folder directories to temporary, -- unique names, wiping all indexes and restarting. reset :: MonadSync m => SyncM m SystemMsg-reset = query postRequest { path = "/rest/reset" }+reset = query postRequest { path = "/rest/system/reset" }  -- | Perform an upgrade to the newest release and restart. Does nothing if -- there is no newer version. upgrade :: MonadSync m => SyncM m (Maybe SystemMsg)-upgrade = maybeSystemMsg $ postRequest { path = "/rest/upgrade" }+upgrade = maybeSystemMsg postRequest { path = "/rest/system/upgrade" } 

@@ -31,14 +31,19 @@     , VersioningConfig(..)     , GuiConfig(..)     , OptionsConfig(..)+    , Connections(..)     , Connection(..)+    , DeviceInfo(..)     , DirTree(..)     , Error(..)     , Ignore(..)     , Model(..)     , ModelState(..)     , Need(..)-    , Progress(..)+    , DBFile(..)+    , FileInfo(..)+    , FolderInfo(..)+    , LastFile(..)     , System(..)     , SystemMsg(..)     , Upgrade(..)

@@ -39,20 +39,20 @@  instance FromJSON Config where     parseJSON (Object v) =-        Config <$> (v .: "Version")-               <*> (v .: "Folders")-               <*> (v .: "Devices")-               <*> (v .: "GUI")-               <*> (v .: "Options")+        Config <$> (v .: "version")+               <*> (v .: "folders")+               <*> (v .: "devices")+               <*> (v .: "gui")+               <*> (v .: "options")     parseJSON _          = mzero  instance ToJSON Config where     toJSON Config{..} =-        object [ "Version"  .= getConfigVersion-               , "Folders"  .= getFolderConfigs-               , "Devices"  .= getDeviceConfigs-               , "GUI"      .= getGuiConfig-               , "Options"  .= getOptionsConfig+        object [ "version"  .= getConfigVersion+               , "folders"  .= getFolderConfigs+               , "devices"  .= getDeviceConfigs+               , "gui"      .= getGuiConfig+               , "options"  .= getOptionsConfig                ]  @@ -87,41 +87,50 @@     , getReadOnly        :: Bool     , getRescanIntervalS :: Int     , getIgnorePerms     :: Bool+    , getAutoNormalize   :: Bool     , getVersioning      :: VersioningConfig     , getLenientMtimes   :: Bool     , getCopiers         :: Int     , getPullers         :: Int+    , getHashers         :: Int+    , getOrder           :: Text     , getFolderInvalid   :: Text     } deriving (Eq, Show)  instance FromJSON FolderConfig where     parseJSON (Object v) =-        FolderConfig <$> (v .: "ID")-                     <*> (v .: "Path")-                     <*> (map getFolderDevice <$> (v .: "Devices"))-                     <*> (v .: "ReadOnly")-                     <*> (v .: "RescanIntervalS")-                     <*> (v .: "IgnorePerms")-                     <*> (v .: "Versioning")-                     <*> (v .: "LenientMtimes")-                     <*> (v .: "Copiers")-                     <*> (v .: "Pullers")-                     <*> (v .: "Invalid")+        FolderConfig <$> (v .: "id")+                     <*> (v .: "path")+                     <*> (map getFolderDevice <$> (v .: "devices"))+                     <*> (v .: "readOnly")+                     <*> (v .: "rescanIntervalS")+                     <*> (v .: "ignorePerms")+                     <*> (v .: "autoNormalize")+                     <*> (v .: "versioning")+                     <*> (v .: "lenientMTimes")+                     <*> (v .: "copiers")+                     <*> (v .: "pullers")+                     <*> (v .: "hashers")+                     <*> (v .: "order")+                     <*> (v .: "invalid")     parseJSON _          = mzero  instance ToJSON FolderConfig where     toJSON FolderConfig{..} =-        object [ "ID"              .= getId-               , "Path"            .= getPath-               , "Devices"         .= map FolderDeviceConfig getFolderDevices-               , "ReadOnly"        .= getReadOnly-               , "RescanIntervalS" .= getRescanIntervalS-               , "IgnorePerms"     .= getIgnorePerms-               , "Versioning"      .= getVersioning-               , "LenientMtimes"   .= getLenientMtimes-               , "Copiers"         .= getCopiers-               , "Pullers"         .= getPullers-               , "Invalid"         .= getFolderInvalid+        object [ "id"              .= getId+               , "path"            .= getPath+               , "devices"         .= map FolderDeviceConfig getFolderDevices+               , "readOnly"        .= getReadOnly+               , "rescanIntervalS" .= getRescanIntervalS+               , "ignorePerms"     .= getIgnorePerms+               , "autoNormalize"   .= getAutoNormalize+               , "versioning"      .= getVersioning+               , "lenientMTimes"   .= getLenientMtimes+               , "copiers"         .= getCopiers+               , "pullers"         .= getPullers+               , "hashers"         .= getHashers+               , "order"           .= getOrder+               , "invalid"         .= getFolderInvalid                ]  @@ -137,14 +146,14 @@  instance FromJSON VersioningConfig where     parseJSON (Object v) =-        VersioningConfig <$> (v .: "Type")-                         <*> (v .: "Params")+        VersioningConfig <$> (v .: "type")+                         <*> (v .: "params")     parseJSON _          = mzero  instance ToJSON VersioningConfig where     toJSON VersioningConfig{..} =-        object [ "Type"   .= getType-               , "Params" .= getParams+        object [ "type"   .= getType+               , "params" .= getParams                ]  @@ -157,29 +166,29 @@       getDevice      :: Device     , getDeviceName  :: Text     , getAddresses   :: [AddressType]-    , getCompression :: Bool+    , getCompression :: Text     , getCertName    :: Text     , getIntroducer  :: Bool     } deriving (Eq, Show)  instance FromJSON DeviceConfig where     parseJSON (Object v) =-        DeviceConfig <$> (v .: "DeviceID")-                     <*> (v .: "Name")-                     <*> (map decodeAddressType <$> (v .: "Addresses"))-                     <*> (v .: "Compression")-                     <*> (v .: "CertName")-                     <*> (v .: "Introducer")+        DeviceConfig <$> (v .: "deviceID")+                     <*> (v .: "name")+                     <*> (map decodeAddressType <$> (v .: "addresses"))+                     <*> (v .: "compression")+                     <*> (v .: "certName")+                     <*> (v .: "introducer")     parseJSON _          = mzero  instance ToJSON DeviceConfig where     toJSON DeviceConfig{..} =-        object [ "DeviceID"     .= getDevice-               , "Name"         .= getDeviceName-               , "Addresses"    .= map encodeAddressType getAddresses-               , "Compression"  .= getCompression-               , "CertName"     .= getCertName-               , "Introducer"   .= getIntroducer+        object [ "deviceID"     .= getDevice+               , "name"         .= getDeviceName+               , "addresses"    .= map encodeAddressType getAddresses+               , "compression"  .= getCompression+               , "certName"     .= getCertName+               , "introducer"   .= getIntroducer                ]  @@ -192,12 +201,12 @@     } deriving (Eq, Show)  instance FromJSON FolderDeviceConfig where-    parseJSON (Object v) = FolderDeviceConfig <$> (v .: "DeviceID")+    parseJSON (Object v) = FolderDeviceConfig <$> (v .: "deviceID")     parseJSON _          = mzero  instance ToJSON FolderDeviceConfig where     toJSON (FolderDeviceConfig device) =-        object [ "DeviceID" .= device ]+        object [ "deviceID" .= device ]   -------------------------------------------------------------------------------@@ -216,22 +225,22 @@  instance FromJSON GuiConfig where     parseJSON (Object v) =-        GuiConfig <$> (v .: "Enabled")-                  <*> (decodeApiKey <$> (v .: "APIKey"))-                  <*> (parseAddr <$> (v .: "Address"))-                  <*> (v .: "User")-                  <*> (v .: "Password")-                  <*> (v .: "UseTLS")+        GuiConfig <$> (v .: "enabled")+                  <*> (decodeApiKey <$> (v .: "apiKey"))+                  <*> (parseAddr <$> (v .: "address"))+                  <*> (v .: "user")+                  <*> (v .: "password")+                  <*> (v .: "useTLS")     parseJSON _          = mzero  instance ToJSON GuiConfig where     toJSON GuiConfig{..} =-        object [ "Enabled"  .= getEnabled-               , "APIKey"   .= encodeApiKey getApiKey-               , "Address"  .= encodeAddr getGuiAddress-               , "User"     .= getUser-               , "Password" .= getPassword-               , "UseTLS"   .= getUseTLS+        object [ "enabled"  .= getEnabled+               , "apiKey"   .= encodeApiKey getApiKey+               , "address"  .= encodeAddr getGuiAddress+               , "user"     .= getUser+               , "password" .= getPassword+               , "useTLS"   .= getUseTLS                ]  decodeApiKey :: Text -> Maybe Text@@ -248,75 +257,81 @@ -- | Various config settings. data OptionsConfig = OptionsConfig {       getListenAddress           :: [Addr]-    , getGlobalAnnServers        :: [Text]-    , getGlobalAnnEnabled        :: Bool-    , getLocalAnnEnabled         :: Bool-    , getLocalAnnPort            :: Int-    , getLocalAnnMCAddr          :: Text+    , getGlobalAnnounceServers   :: [Text]+    , getGlobalAnnounceEnabled   :: Bool+    , getLocalAnnounceEnabled    :: Bool+    , getLocalAnnouncePort       :: Int+    , getLocalAnnounceMCAddr     :: Text     , getMaxSendKbps             :: Int     , getMaxRecvKbps             :: Int-    , getReconnectIntervalS      :: Int+    , getReconnectionIntervalS   :: Int     , getStartBrowser            :: Bool-    , getUPnPEnabled             :: Bool-    , getUPnPLease               :: Int-    , getUPnPRenewal             :: Int-    , getURAccepted              :: Int-    , getURUniqueID              :: Text+    , getUpnpEnabled             :: Bool+    , getUpnpLeaseMinutes        :: Int+    , getUpnpRenewalMinutes      :: Int+    , getUpnpTimeoutSeconds      :: Int+    , getUrAccepted              :: Int+    , getUrUniqueID              :: Text     , getRestartOnWakeup         :: Bool     , getAutoUpgradeIntervalH    :: Int     , getKeepTemporariesH        :: Int     , getCacheIgnoredFiles       :: Bool     , getProgressUpdateIntervalS :: Int     , getSymlinksEnabled         :: Bool+    , getLimitBandwidthInLan     :: Bool } deriving (Eq, Show)  instance FromJSON OptionsConfig where     parseJSON (Object v) =-        OptionsConfig <$> (map parseAddr <$> (v .: "ListenAddress"))-                      <*> (v .: "GlobalAnnServers")-                      <*> (v .: "GlobalAnnEnabled")-                      <*> (v .: "LocalAnnEnabled")-                      <*> (v .: "LocalAnnPort")-                      <*> (v .: "LocalAnnMCAddr")-                      <*> (v .: "MaxSendKbps")-                      <*> (v .: "MaxRecvKbps")-                      <*> (v .: "ReconnectIntervalS")-                      <*> (v .: "StartBrowser")-                      <*> (v .: "UPnPEnabled")-                      <*> (v .: "UPnPLease")-                      <*> (v .: "UPnPRenewal")-                      <*> (v .: "URAccepted")-                      <*> (v .: "URUniqueID")-                      <*> (v .: "RestartOnWakeup")-                      <*> (v .: "AutoUpgradeIntervalH")-                      <*> (v .: "KeepTemporariesH")-                      <*> (v .: "CacheIgnoredFiles")-                      <*> (v .: "ProgressUpdateIntervalS")-                      <*> (v .: "SymlinksEnabled")+        OptionsConfig <$> (map parseAddr <$> (v .: "listenAddress"))+                      <*> (v .: "globalAnnounceServers")+                      <*> (v .: "globalAnnounceEnabled")+                      <*> (v .: "localAnnounceEnabled")+                      <*> (v .: "localAnnouncePort")+                      <*> (v .: "localAnnounceMCAddr")+                      <*> (v .: "maxSendKbps")+                      <*> (v .: "maxRecvKbps")+                      <*> (v .: "reconnectionIntervalS")+                      <*> (v .: "startBrowser")+                      <*> (v .: "upnpEnabled")+                      <*> (v .: "upnpLeaseMinutes")+                      <*> (v .: "upnpRenewalMinutes")+                      <*> (v .: "upnpTimeoutSeconds")+                      <*> (v .: "urAccepted")+                      <*> (v .: "urUniqueId")+                      <*> (v .: "restartOnWakeup")+                      <*> (v .: "autoUpgradeIntervalH")+                      <*> (v .: "keepTemporariesH")+                      <*> (v .: "cacheIgnoredFiles")+                      <*> (v .: "progressUpdateIntervalS")+                      <*> (v .: "symlinksEnabled")+                      <*> (v .: "limitBandwidthInLan")     parseJSON _          = mzero  instance ToJSON OptionsConfig where     toJSON OptionsConfig{..} =-        object [ "ListenAddress"           .= map encodeAddr getListenAddress-               , "GlobalAnnServers"        .= getGlobalAnnServers-               , "GlobalAnnEnabled"        .= getGlobalAnnEnabled-               , "LocalAnnEnabled"         .= getLocalAnnEnabled-               , "LocalAnnPort"            .= getLocalAnnPort-               , "LocalAnnMCAddr"          .= getLocalAnnMCAddr-               , "MaxSendKbps"             .= getMaxSendKbps-               , "MaxRecvKbps"             .= getMaxRecvKbps-               , "ReconnectIntervalS"      .= getReconnectIntervalS-               , "StartBrowser"            .= getStartBrowser-               , "UPnPEnabled"             .= getUPnPEnabled-               , "UPnPLease"               .= getUPnPLease-               , "UPnPRenewal"             .= getUPnPRenewal-               , "URAccepted"              .= getURAccepted-               , "URUniqueID"              .= getURUniqueID-               , "RestartOnWakeup"         .= getRestartOnWakeup-               , "AutoUpgradeIntervalH"    .= getAutoUpgradeIntervalH-               , "KeepTemporariesH"        .= getKeepTemporariesH-               , "CacheIgnoredFiles"       .= getCacheIgnoredFiles-               , "ProgressUpdateIntervalS" .= getProgressUpdateIntervalS-               , "SymlinksEnabled"         .= getSymlinksEnabled+        object [ "listenAddress"           .= map encodeAddr getListenAddress+               , "globalAnnounceServers"   .= getGlobalAnnounceServers+               , "globalAnnounceEnabled"   .= getGlobalAnnounceEnabled+               , "localAnnounceEnabled"    .= getLocalAnnounceEnabled+               , "localAnnouncePort"       .= getLocalAnnouncePort+               , "localAnnounceMCAddr"     .= getLocalAnnounceMCAddr+               , "maxSendKbps"             .= getMaxSendKbps+               , "maxRecvKbps"             .= getMaxRecvKbps+               , "reconnectionIntervalS"   .= getReconnectionIntervalS+               , "startBrowser"            .= getStartBrowser+               , "upnpEnabled"             .= getUpnpEnabled+               , "upnpLeaseMinutes"        .= getUpnpLeaseMinutes+               , "upnpRenewalMinutes"      .= getUpnpRenewalMinutes+               , "upnpTimeoutSeconds"      .= getUpnpTimeoutSeconds+               , "urAccepted"              .= getUrAccepted+               , "urUniqueId"              .= getUrUniqueID+               , "restartOnWakeup"         .= getRestartOnWakeup+               , "autoUpgradeIntervalH"    .= getAutoUpgradeIntervalH+               , "keepTemporariesH"        .= getKeepTemporariesH+               , "cacheIgnoredFiles"       .= getCacheIgnoredFiles+               , "progressUpdateIntervalS" .= getProgressUpdateIntervalS+               , "symlinksEnabled"         .= getSymlinksEnabled+               , "limitBandwidthInLan"     .= getLimitBandwidthInLan                ] 

@@ -3,15 +3,17 @@  module Network.Syncthing.Types.Connection     ( Connection(..)+    , Connections(..)     ) where  import           Control.Applicative              ((<$>), (<*>)) import           Control.Monad                    (MonadPlus (mzero)) import           Data.Aeson                       (FromJSON, Value (..), parseJSON, (.:))+import qualified Data.Map                         as M import           Data.Text                        (Text) import           Data.Time.Clock                  (UTCTime) -import           Network.Syncthing.Types.Common   (Addr)+import           Network.Syncthing.Types.Common   (Addr, Device) import           Network.Syncthing.Internal.Utils (parseAddr, toUTC)  @@ -26,10 +28,22 @@  instance FromJSON Connection where     parseJSON (Object v) =-        Connection <$> (toUTC <$> (v .:  "At"))-                   <*> (v .:  "InBytesTotal")-                   <*> (v .:  "OutBytesTotal")-                   <*> (parseAddr <$> (v .:  "Address"))-                   <*> (v .:  "ClientVersion")+        Connection <$> (toUTC <$> (v .:  "at"))+                   <*> (v .:  "inBytesTotal")+                   <*> (v .:  "outBytesTotal")+                   <*> (parseAddr <$> (v .:  "address"))+                   <*> (v .:  "clientVersion")+    parseJSON _          = mzero++-- | Contains the list of current connections.+data Connections = Connections {+      getConnections    :: M.Map Device Connection+    , getTotal          :: Connection+    } deriving (Eq, Show)++instance FromJSON Connections where+    parseJSON (Object v) =+        Connections <$> (v .:  "connections")+                    <*> (v .:  "total")     parseJSON _          = mzero 

@@ -0,0 +1,29 @@++{-# LANGUAGE OverloadedStrings #-}++module Network.Syncthing.Types.DBFile+    ( DBFile(..)+    ) where++import           Control.Applicative              ((<$>), (<*>))+import           Control.Monad                    (MonadPlus (mzero))+import           Data.Aeson                       (FromJSON, Value (..), parseJSON, (.:))++import           Network.Syncthing.Types.Common   (Device)+import           Network.Syncthing.Types.FileInfo (FileInfo)+++-- | Contains data available about a given file.+data DBFile = DBFile {+      getAvailability   :: [Device]+    , getGlobal         :: FileInfo+    , getLocal          :: FileInfo+    } deriving (Eq, Show)++instance FromJSON DBFile where+    parseJSON (Object v) =+        DBFile <$> (v .: "availability")+               <*> (v .: "global")+               <*> (v .: "local")+    parseJSON _          = mzero+

@@ -0,0 +1,24 @@++{-# LANGUAGE OverloadedStrings #-}++module Network.Syncthing.Types.DeviceInfo+    ( DeviceInfo(..)+    ) where++import           Control.Applicative              ((<$>))+import           Control.Monad                    (MonadPlus (mzero))+import           Data.Aeson                       (FromJSON, Value (..), parseJSON, (.:))+import           Data.Time.Clock                  (UTCTime)++import           Network.Syncthing.Internal.Utils (toUTC)+++-- | Contains information about a device.+data DeviceInfo = DeviceInfo    {+      getLastSeen   :: Maybe UTCTime+    } deriving (Eq, Show)++instance FromJSON DeviceInfo where+    parseJSON (Object v) = DeviceInfo <$> (toUTC <$> v .: "lastSeen")+    parseJSON _          = mzero+

@@ -5,31 +5,32 @@     ( DirTree(..)     ) where -import           Control.Applicative ((<$>))-import           Control.Monad       (MonadPlus (mzero))-import           Data.Aeson          (FromJSON, Value (..), parseJSON)-import qualified Data.Map            as M-import           Data.Text           (Text)+import           Control.Applicative              ((<$>), (<*>))+import           Control.Monad                    (MonadPlus (mzero))+import           Data.Aeson                       (FromJSON, Value (..),+                                                   parseJSON)+import qualified Data.Map                         as M+import           Data.Text                        (Text)+import           Data.Time.Clock                  (UTCTime)+import           Data.Vector                      ((!)) +import           Network.Syncthing.Internal.Utils (toUTC) + -- | A directory tree contains files or subdirectories.-data DirTree +data DirTree     = Dir {         getDirContents :: M.Map Text DirTree       }     | File {-        getModTime  :: Integer    -- ^ file modification time-      , getFileSize :: Integer    -- ^ file size-      } +        getModTime  :: Maybe UTCTime    -- ^ file modification time+      , getFileSize :: Integer          -- ^ file size+      }     deriving (Eq, Show)  instance FromJSON DirTree where-    parseJSON obj@(Object _) = Dir <$> parseJSON obj-    parseJSON arr@(Array _)  = decodeFile <$> parseJSON arr+    parseJSON obj@(Object _) = Dir  <$> parseJSON obj+    parseJSON (Array v)      = File <$> (toUTC <$> parseJSON (v ! 0))+                                    <*> parseJSON (v ! 1)     parseJSON _              = mzero---decodeFile :: [Integer] -> DirTree-decodeFile [modTime, fileSize] = File modTime fileSize-decodeFile _                   = File 0 0 

@@ -26,8 +26,8 @@  instance FromJSON Error where     parseJSON (Object v) =-        Error <$> (toUTC <$> (v .:  "Time"))-              <*> (v .:  "Error")+        Error <$> (toUTC <$> (v .:  "time"))+              <*> (v .:  "error")     parseJSON _          = mzero  instance FromJSON Errors where

@@ -0,0 +1,39 @@++{-# LANGUAGE OverloadedStrings #-}++module Network.Syncthing.Types.FileInfo+    ( FileInfo(..)+    ) where++import           Control.Applicative              ((<$>), (<*>))+import           Control.Monad                    (MonadPlus (mzero))+import           Data.Aeson                       (FromJSON, Value (..),+                                                   parseJSON, (.:), (.:?))+import           Data.Text                        (Text)+import           Data.Time.Clock                  (UTCTime)++import           Network.Syncthing.Internal.Utils (toUTC)+++-- | All available information about a file.+data FileInfo = FileInfo {+      getName         :: Text+    , getFlags        :: Text+    , getModified     :: Maybe UTCTime+    , getFileVersion  :: [Text]+    , getLocalVersion :: Int+    , getSize         :: Integer+    , getNumBlocks    :: Maybe Int+    } deriving (Eq, Show)++instance FromJSON FileInfo where+    parseJSON (Object v) =+        FileInfo <$> (v .: "name")+                 <*> (v .: "flags")+                 <*> (toUTC <$> (v .: "modified"))+                 <*> (v .: "version")+                 <*> (v .: "localVersion")+                 <*> (v .: "size")+                 <*> (v .:? "numBlocks")+    parseJSON _          = mzero+

@@ -0,0 +1,38 @@++{-# LANGUAGE OverloadedStrings #-}++module Network.Syncthing.Types.FolderInfo+    ( FolderInfo(..)+    , LastFile(..)+    ) where++import           Control.Applicative              ((<$>), (<*>))+import           Control.Monad                    (MonadPlus (mzero))+import           Data.Aeson                       (FromJSON, Value (..), parseJSON, (.:))+import           Data.Text                        (Text)+import           Data.Time.Clock                  (UTCTime)++import           Network.Syncthing.Internal.Utils (toUTC)+++-- | Contains general statistics about folders.+data FolderInfo = FolderInfo {+      getLastFile :: LastFile+    } deriving (Eq, Show)++-- | Information about the last synced file.+data LastFile = LastFile {+      getFileName  :: Text+    , getSyncedAt  :: Maybe UTCTime+    } deriving (Eq, Show)++instance FromJSON FolderInfo where+    parseJSON (Object v) = FolderInfo <$> (v .:  "lastFile")+    parseJSON _          = mzero++instance FromJSON LastFile where+    parseJSON (Object v) =+        LastFile <$> (v .: "filename")+                 <*> (toUTC <$> (v .: "at"))+    parseJSON _          = mzero+

@@ -3,44 +3,22 @@  module Network.Syncthing.Types.Need     ( Need(..)-    , Progress(..)     ) where -import           Control.Applicative ((<$>), (<*>))-import           Control.Monad       (MonadPlus (mzero))-import           Data.Aeson          (FromJSON, Value (..), parseJSON, (.:))-import           Data.Text           (Text)+import           Control.Applicative              ((<$>), (<*>))+import           Control.Monad                    (MonadPlus (mzero))+import           Data.Aeson                       (FromJSON, Value (..), parseJSON, (.:)) +import           Network.Syncthing.Types.FileInfo (FileInfo) + -- | Contains lists of files which are needed by a device for becoming in -- sync. data Need = Need {-      getProgress :: [Progress]-    , getQueued   :: [Text]-    , getRest     :: [Text]-    } deriving (Eq, Show)---- | A file that is currently downloading. -data Progress = Progress { -      getName            :: Text-    , getFlags           :: Int-    , getModified        :: Integer-    , getProgressVersion :: Int-    , getLocalVersion    :: Int-    , getNumBlocks       :: Int-    , getSize            :: Integer+      getProgress :: [FileInfo]+    , getQueued   :: [FileInfo]+    , getRest     :: [FileInfo]     } deriving (Eq, Show)--instance FromJSON Progress where-    parseJSON (Object v) =-        Progress <$> (v .: "Name")-                 <*> (v .: "Flags")-                 <*> (v .: "Modified")-                 <*> (v .: "Version")-                 <*> (v .: "LocalVersion")-                 <*> (v .: "NumBlocks")-                 <*> (v .: "Size")-    parseJSON _          = mzero  instance FromJSON Need where     parseJSON (Object v) =

@@ -22,6 +22,9 @@     , getGoRoutines    :: Int     , getMyId          :: Text     , getSys           :: Integer+    , getPathSeparator :: Text+    , getTilde         :: Text+    , getUptime        :: Integer     } deriving (Eq, Show)  instance FromJSON System where@@ -32,5 +35,8 @@                <*> (v .:  "goroutines")                <*> (v .:  "myID")                <*> (v .:  "sys")+               <*> (v .:  "pathSeparator")+               <*> (v .:  "tilde")+               <*> (v .:  "uptime")     parseJSON _          = mzero 

@@ -26,9 +26,9 @@ ``` haskell {-# LANGUAGE OverloadedStrings #-} -import qualified Network.Wreq as Wreq-import Control.Monad (liftM2) import Control.Lens ((&), (.~), (?~))+import Control.Monad (liftM2)+import qualified Network.Wreq as Wreq import Network.Syncthing import qualified Network.Syncthing.Get as Get 

@@ -1,3 +1,8 @@+0.2.0.0+-------+* Update library for Syncthing v0.11+* Refactor package internals+ 0.1.2.0 ------- * Update lower bounds of package dependencies 

@@ -1,5 +1,5 @@ name:                syncthing-hs-version:             0.1.2.0+version:             0.2.0.0 synopsis:            Haskell bindings for the Syncthing REST API description:              .@@ -40,7 +40,11 @@                      Network.Syncthing.Types.Config                      Network.Syncthing.Types.Connection                      Network.Syncthing.Types.DeviceId+                     Network.Syncthing.Types.DeviceInfo                      Network.Syncthing.Types.DirTree+                     Network.Syncthing.Types.DBFile+                     Network.Syncthing.Types.FileInfo+                     Network.Syncthing.Types.FolderInfo                      Network.Syncthing.Types.Error                      Network.Syncthing.Types.Ignore                      Network.Syncthing.Types.Model@@ -69,6 +73,7 @@                      , time >=1.4.2                      , transformers >=0.2.2.1                      , unordered-containers >=0.2.3.3+                     , vector >= 0.10.12.3                      , wreq >=0.3.0.0   -- hs-source-dirs:       default-language:  Haskell2010@@ -80,16 +85,22 @@                      , base >=4.5 && <5                      , bytestring >=0.9                      , containers >= 0.5.5.1+                     , data-default                      , derive                        , either >=4.0+                     , exceptions >= 0.5                      , lens >=4.5 +                     , http-client >=0.4.6+                     , http-types >= 0.8                      , quickcheck-instances+                     , scientific >= 0.3.3.8                      , syncthing-hs                      , tasty                      , tasty-hunit                      , tasty-quickcheck                      , text >=1.1.1.0                      , transformers >=0.2.2.1+                     , vector >= 0.10.12.3                      , wreq >=0.3.0.0   other-modules:     Properties.ErrorProperties                      Properties.JsonArbitrary

@@ -111,6 +111,8 @@                       <*> arbitrary                       <*> arbitrary                       <*> arbitrary+                      <*> arbitrary+                      <*> arbitrary  instance Arbitrary DirTree where     arbitrary = choose (0, 5) >>= dirTree@@ -138,7 +140,8 @@                 , ''ModelState                 , ''Upgrade                 , ''Ignore-                , ''Progress+                , ''DBFile+                , ''FileInfo                 , ''Need                 , ''Sync                 , ''DeviceError@@ -146,5 +149,9 @@                 , ''Errors                 , ''System                 , ''UsageReport+                , ''Connections+                , ''DeviceInfo+                , ''FolderInfo+                , ''LastFile                 ] 

@@ -8,8 +8,10 @@  import           Control.Applicative              ((<$>), pure) import           Data.Aeson                       hiding (Error)-import           Data.Maybe                       (fromMaybe)+import           Data.Maybe                       (fromMaybe, maybeToList)+import           Data.Scientific                  (scientific) import qualified Data.Text                        as T+import qualified Data.Vector                      as V  import           Network.Syncthing.Internal @@ -56,13 +58,19 @@  instance ToJSON Connection where     toJSON Connection{..} =-        object [ "At"            .= encodeUTC getAt-               , "InBytesTotal"  .= getInBytesTotal-               , "OutBytesTotal" .= getOutBytesTotal-               , "Address"       .= encodeAddr getAddress-               , "ClientVersion" .= getClientVersion+        object [ "at"            .= encodeUTC getAt+               , "inBytesTotal"  .= getInBytesTotal+               , "outBytesTotal" .= getOutBytesTotal+               , "address"       .= encodeAddr getAddress+               , "clientVersion" .= getClientVersion                ] +instance ToJSON Connections where+    toJSON Connections{..} =+        object [ "connections"   .= getConnections+               , "total"         .= getTotal+               ]+ instance ToJSON Model where     toJSON Model{..} =         object [ "globalBytes"   .= getGlobalBytes   @@ -101,15 +109,22 @@                , "rest"     .= getRest                ] -instance ToJSON Progress where-    toJSON Progress{..} =-        object [ "Name"         .= getName            -               , "Flags"        .= getFlags           -               , "Modified"     .= getModified        -               , "Version"      .= getProgressVersion -               , "LocalVersion" .= getLocalVersion    -               , "NumBlocks"    .= getNumBlocks       -               , "Size"         .= getSize            +instance ToJSON FileInfo where+    toJSON FileInfo{..} =+        object $ [ "name"         .= getName            +                 , "flags"        .= getFlags           +                 , "modified"     .= encodeUTC getModified        +                 , "version"      .= getFileVersion +                 , "localVersion" .= getLocalVersion    +                 , "size"         .= getSize            +                 ]+                 ++ maybeToList (("numBlocks" .=) <$> getNumBlocks)++instance ToJSON DBFile where+    toJSON DBFile{..} =+        object [ "availability" .= getAvailability+               , "global"       .= getGlobal+               , "local"        .= getLocal                ]  instance ToJSON System where@@ -120,6 +135,9 @@                , "goroutines"       .= getGoRoutines                 , "myID"             .= getMyId                    , "sys"              .= getSys       +               , "pathSeparator"    .= getPathSeparator+               , "tilde"            .= getTilde       +               , "uptime"           .= getUptime                ]  instance ToJSON (Either DeviceError Device) where@@ -145,16 +163,31 @@  instance ToJSON Error where     toJSON Error{..} =-        object [ "Time"  .= encodeUTC getTime-               , "Error" .= getMsg+        object [ "time"  .= encodeUTC getTime+               , "error" .= getMsg                ]  instance ToJSON Errors where     toJSON = singleField "errors" . getErrors  +instance ToJSON DeviceInfo where+    toJSON DeviceInfo{..} = object [ "lastSeen" .= encodeUTC getLastSeen ]+    +instance ToJSON FolderInfo where+    toJSON FolderInfo{..} = object [ "lastFile" .= getLastFile ]++instance ToJSON LastFile where+    toJSON LastFile{..} = +        object [ "filename" .= getFileName+               , "at"       .= encodeUTC getSyncedAt +               ]+ instance ToJSON DirTree where     toJSON Dir{..}  = toJSON getDirContents-    toJSON File{..} = toJSON [getModTime, getFileSize] +    toJSON File{..} = Array $ V.fromList [modTime, fileSize]+      where+        modTime  = String . T.pack . encodeUTC $ getModTime+        fileSize = Number $ scientific getFileSize 0  instance ToJSON UsageReport where     toJSON UsageReport{..} =

@@ -30,10 +30,12 @@     , genProp "Completion"       (prop_json :: Completion -> Bool)     , genProp "CacheEntry"       (prop_json :: CacheEntry -> Bool)     , genProp "Connection"       (prop_json :: Connection -> Bool)+    , genProp "Connections"      (prop_json :: Connections -> Bool)     , genProp "Model"            (prop_json :: Model -> Bool)     , genProp "Upgrade"          (prop_json :: Upgrade -> Bool)     , genProp "Ignore"           (prop_json :: Ignore -> Bool)-    , genProp "Progress"         (prop_json :: Progress -> Bool)+    , genProp "FileInfo"         (prop_json :: FileInfo -> Bool)+    , genProp "DBFile"           (prop_json :: DBFile -> Bool)     , genProp "Need"             (prop_json :: Need -> Bool)     , genProp "Sync"             (prop_json :: Sync -> Bool)     , genProp "DeviceId"         (prop_json :: EitherDeviceErrorId -> Bool)@@ -49,5 +51,8 @@     , genProp "System"           (prop_json :: System -> Bool)     , genProp "DirTree"          (prop_json :: DirTree -> Bool)     , genProp "UsageReport"      (prop_json :: UsageReport -> Bool)+    , genProp "DeviceInfo"       (prop_json :: DeviceInfo -> Bool)+    , genProp "FolderInfo"       (prop_json :: FolderInfo -> Bool)+    , genProp "LastFile"         (prop_json :: LastFile -> Bool)     ] 

@@ -1,53 +1,116 @@ +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-}  module UnitTests.Errors     ( errorUnits     ) where -import qualified Data.ByteString.Lazy.Char8 as BS+import           Control.Monad.Catch.Pure+import           Control.Monad.Trans.Class  (lift)+import qualified Data.ByteString            as BS+import           Data.Default               (def) import qualified Data.Text                  as T+import           Network.HTTP.Client+import           Network.HTTP.Types import           Test.Tasty import           Test.Tasty.HUnit +import           Network.Syncthing+import qualified Network.Syncthing.Get      as Get import           Network.Syncthing.Internal  -createTestName :: Show err => err -> String-createTestName = ("Decode " ++) . show -createDescription :: Show err => err -> String -> String-createDescription errType errMsg =-    concat [show errMsg, " decodes to ", show errType]+-------------- Test Infrastructure -------------- -testDecodeError :: SyncError -> BS.ByteString -> TestTree-testDecodeError errType errMsg =-    testCase (createTestName errType) $-        assertEqual (createDescription errType $ BS.unpack errMsg)-                    (Just errType)-                    (decodeError errMsg)+type CatchM        = SyncM Catch+type CatchResult a = Either SomeException (SyncResult a) -testDecodeDeviceError :: DeviceError -> T.Text -> TestTree-testDecodeDeviceError errType errMsg =-    testCase (createTestName errType) $-        assertEqual (createDescription errType $ T.unpack errMsg)-                    errType-                    (decodeDeviceError errMsg) +instance MonadSync Catch where+    getMethod  o s   = return "{\"invalidKey\":\"pong\"}"+    postMethod o s p = return "{\"invalidKey\":\"pong\"}" +instance MonadThrow CatchM where+    throwM = SyncM . throwM ++requestWithException :: Exception ex => ex -> CatchM a -> SyncM Catch a+requestWithException ex action = throwM ex >> action++runRequest :: SyncConfig -> CatchM a -> CatchResult a+runRequest cfg action = runCatch $ syncthingM cfg action++++-------------- Helpers --------------++pingWithEx :: Exception ex => ex -> CatchResult T.Text+pingWithEx ex = runRequest defaultConfig $ requestWithException ex Get.ping++statusCodeEx :: Status -> BS.ByteString -> HttpException+statusCodeEx status msg =+    StatusCodeException status [("X-Response-Body-Start", msg)] def++testParseEx =+    testCase "Handle ParseError" $+        assertBool "JSON parse errors are handled correctly" $+            isHandled $ runRequest defaultConfig Get.ping+  where+    isHandled (Right (Left (ParseError _))) = True+    isHandled _                             = False++testHandledEx :: Exception ex => SyncError -> ex -> TestTree+testHandledEx errType ex =+    testCase ("Handle " ++ show errType) $+        assertBool "Exception is handled correctly" $+            isHandled (pingWithEx ex)+  where+    isHandled (Right (Left err)) = errType == err+    isHandled _                  = False++testUnhandledEx :: Exception ex => ex -> TestTree+testUnhandledEx ex =+    testCase ("Unhandled Exception: " ++ show ex) $+        assertBool "Exception is not handled" $+            isNotHandled (pingWithEx ex)+  where+    isNotHandled (Left _) = True+    isNotHandled _        = False++testDeviceError :: DeviceError -> T.Text -> TestTree+testDeviceError errType errMsg =+    testCase ("Decoding " ++ show errType) $+        assertEqual description errType (decodeDeviceError errMsg)+  where+    description = concat [show (T.unpack errMsg), " decodes to ", show errType]++++-------------- Test Suite --------------+ errorUnits :: TestTree-errorUnits = testGroup "Unit Tests for error messages" $-    map (uncurry testDecodeError)-    [ (CSRFError, "CSRF Error")-    , (NotAuthorized, "Not Authorized")-    , (NotFound, "404 page not found")-    , (NoSuchFolder, "no such folder")-    , ((InvalidDeviceId IncorrectLength), "device ID invalid: incorrect length")-    , ((InvalidDeviceId IncorrectCheckDigit), "check digit incorrect")-    ]-    ++-    map (uncurry testDecodeDeviceError)-    [ (IncorrectLength, "device ID invalid: incorrect length")-    , (IncorrectCheckDigit, "check digit incorrect")+errorUnits = testGroup "Error Handling Unit Tests"+    [ testGroup "Handled Exceptions"+        [ testParseEx+        , testHandledEx CSRFError $ statusCodeEx status403 "CSRF Error"+        , testHandledEx NotAuthorized $ statusCodeEx status401 "Not Authorized"+        , testHandledEx NotFound $ statusCodeEx status404 "404 page not found"+        , testHandledEx NoSuchFolder $ statusCodeEx status500 "no such folder"+        , testHandledEx (InvalidDeviceId IncorrectLength)+            (statusCodeEx status500 "device ID invalid: incorrect length")+        , testHandledEx (InvalidDeviceId IncorrectCheckDigit)+            (statusCodeEx status500 "check digit incorrect")+        ]+    , testGroup "Unhandled Exceptions"+        [ testUnhandledEx $ statusCodeEx status500 "unknown Error"+        , testUnhandledEx TooManyRetries+        , testUnhandledEx ResponseTimeout+        , testUnhandledEx $ FailedConnectionException "127.0.0.1" 8080+        ]+    , testGroup "Decoding Device Errors"+        [ testDeviceError IncorrectLength "device ID invalid: incorrect length"+        , testDeviceError IncorrectCheckDigit "check digit incorrect"+        ]     ] 

@@ -9,8 +9,6 @@  import           Control.Applicative        ((<$>)) import           Control.Lens               ((&), (.~), (?~), (^.))-import           Control.Monad.Trans.Either (runEitherT)-import           Control.Monad.Trans.Reader (runReaderT) import           Control.Monad.Trans.Writer (Writer, execWriter, tell) import           Data.Aeson                 (ToJSON, Value, toJSON) import           Data.List                  (isPrefixOf, sort)@@ -57,8 +55,7 @@     postMethod o s p = tell [ LoggedRequest POST s o (Just p) ] >> return ""  mockedSyncthing :: SyncConfig -> LogAction a -> LogResult a-mockedSyncthing config action =-    flip runReaderT config $ runEitherT $ runSyncthing action+mockedSyncthing = runSyncM  extractRequest :: LogResult a -> LoggedRequest extractRequest = head . execWriter@@ -124,7 +121,7 @@  -------------- Basic Tests -------------- -basicRequest rType endpoint action  = withRequest action $+basicReq rType endpoint action  = withRequest action $     \LoggedRequest{..} -> do         assertReqType rType reqType          assertUrl defaultConfig endpoint reqUrl@@ -136,7 +133,7 @@         cfg    = defaultConfig & pServer .~ server     in     withConfigRequest cfg Get.ping $-        \LoggedRequest{..} -> assertUrl cfg "/rest/ping" reqUrl+        \LoggedRequest{..} -> assertUrl cfg "/rest/system/ping" reqUrl  setApiKey =     let apiKey = "123456789XYZ"@@ -191,7 +188,7 @@ testPostConfig endpoint params =      testCase ("Test POST " ++ endpoint) $ do         configSample <- head <$> sample' (arbitrary :: Gen Config)-        withRequest (Post.sendConfig configSample) $ +        withRequest (Post.config configSample) $              \loggedRequest ->                  assertPost loggedRequest endpoint params configSample @@ -202,8 +199,8 @@ requestUnits :: TestTree requestUnits = testGroup "Unit Tests for Requests"      [ testGroup "Basic Tests"-        [ testCase "GET Request"  $ basicRequest GET  "/rest/ping" Get.ping-        , testCase "POST Request" $ basicRequest POST "/rest/ping" Post.ping+        [ testCase "GET Request"  $ basicReq GET  "/rest/system/ping" Get.ping+        , testCase "POST Request" $ basicReq POST "/rest/system/ping" Post.ping         , testCase "changeServer"           changeServer         , testCase "set ApiKey"             setApiKey         , testCase "enable Authentication"  enableAuth@@ -211,76 +208,83 @@         , testCase "disable HTTPS usage"    disableHttps         ]     , testGroup "GET Requests"-        [ testGet "/rest/ping"          noParams Get.ping-        , testGet "/rest/completion"+        [ testGet "/rest/system/ping"           noParams Get.ping+        , testGet "/rest/db/completion"                   [("folder","default"), ("device", "device1")]                    (Get.completion "device1" "default")-        , testGet "/rest/config"        noParams Get.config-        , testGet "/rest/connections"   noParams Get.connections-        , testGet "/rest/deviceid" +        , testGet "/rest/system/config"         noParams Get.config+        , testGet "/rest/system/connections"    noParams Get.connections+        , testGet "/rest/svc/deviceid"                    [("id", "device1")]                    (Get.deviceId "device1")-        , testGet "/rest/discovery"     noParams Get.discovery-        , testGet "/rest/errors"        noParams Get.errors-        , testGet "/rest/ignores" +        , testGet "/rest/system/discovery"      noParams Get.discovery+        , testGet "/rest/system/error"          noParams Get.errors+        , testGet "/rest/db/ignores"                    [("folder", "default")]                    (Get.ignores "default")-        , testGet "/rest/model" +        , testGet "/rest/db/status"                    [("folder", "default")] -                  (Get.model "default")-        , testGet "/rest/need"  +                  (Get.dbStatus "default")+        , testGet "/rest/db/need"                     [("folder", "default")]                    (Get.need "default")-        , testGet "/rest/config/sync"   noParams Get.sync-        , testGet "/rest/report"        noParams Get.report-        , testGet "/rest/system"        noParams Get.system-        , testGet "/rest/tree"        +        , testGet "/rest/system/config/insync"  noParams Get.insync+        , testGet "/rest/svc/report"            noParams Get.report+        , testGet "/rest/system/status"         noParams Get.sysStatus+        , testGet "/rest/db/browse"                           [("folder", "default")]-                  (Get.tree "default" Nothing Nothing)-        , testGet "/rest/tree"        +                  (Get.browse "default" Nothing Nothing)+        , testGet "/rest/db/browse"                           [("folder", "default"), ("prefix", "foo/bar")]-                  (Get.tree "default" (Just "foo/bar") Nothing)-        , testGet "/rest/tree"        +                  (Get.browse "default" (Just "foo/bar") Nothing)+        , testGet "/rest/db/browse"                           [("folder", "default"), ("levels", "2")]-                  (Get.tree "default" Nothing (Just 2))-        , testGet "/rest/tree"        +                  (Get.browse "default" Nothing (Just 2))+        , testGet "/rest/db/browse"                           [("folder", "default"),("prefix", "foo/bar"),("levels", "2")]-                  (Get.tree "default" (Just "foo/bar") (Just 2))-        , testGet "/rest/upgrade"       noParams Get.upgrade-        , testGet "/rest/version"       noParams Get.version+                  (Get.browse "default" (Just "foo/bar") (Just 2))+        , testGet "/rest/db/file"        +                  [("folder", "default"), ("file", "foo/bar")]+                  (Get.file "default" "foo/bar")+        , testGet "/rest/system/upgrade"        noParams Get.upgrade+        , testGet "/rest/system/version"        noParams Get.version+        , testGet "/rest/svc/lang"              noParams Get.lang+        , testGet "/rest/stats/device"          noParams Get.devices+        , testGet "/rest/stats/folder"          noParams Get.folders         ]     , testGroup "POST Requests"-        [ testPost "/rest/ping"         noParams noPayload Post.ping-        , testPost "/rest/bump"+        [ testPost "/rest/system/ping"          noParams noPayload Post.ping+        , testPost "/rest/db/prio"                    [("folder", "default"), ("file", "foo/bar")]                     noPayload-                   (Post.bump "default" "foo/bar")-        , testPost "/rest/discovery/hint"+                   (Post.prio "default" "foo/bar")+        , testPost "/rest/system/discovery"                    [("device", "device1"), ("addr", "192.168.0.10:8080")]                     noPayload-                   (Post.hint "device1" "192.168.0.10:8080")-        , testPost "/rest/error" +                   (Post.discovery "device1" "192.168.0.10:8080")+        , testPost "/rest/system/error"                     noParams                     (T.pack "Error 1")                     (Post.sendError "Error 1")-        , testPost "/rest/error/clear"  noParams noPayload Post.clearErrors-        , testPost "/rest/scan" +        , testPost "/rest/system/error/clear" +                   noParams noPayload Post.clearErrors+        , testPost "/rest/db/scan"                     [("folder", "default")]                     noPayload -                   (Post.scanFolder "default" Nothing)-        , testPost "/rest/scan"+                   (Post.scan "default" Nothing)+        , testPost "/rest/db/scan"                    [("folder", "default"), ("sub", "foo/bar")]                     noPayload -                   (Post.scanFolder "default" (Just "foo/bar"))-        , testPost "/rest/restart"      noParams noPayload Post.restart-        , testPost "/rest/shutdown"     noParams noPayload Post.shutdown-        , testPost "/rest/reset"        noParams noPayload Post.reset-        , testPost "/rest/upgrade"      noParams noPayload Post.upgrade-        , testPost "/rest/ignores" +                   (Post.scan "default" (Just "foo/bar"))+        , testPost "/rest/system/restart"  noParams noPayload Post.restart+        , testPost "/rest/system/shutdown" noParams noPayload Post.shutdown+        , testPost "/rest/system/reset"    noParams noPayload Post.reset+        , testPost "/rest/system/upgrade"  noParams noPayload Post.upgrade+        , testPost "/rest/db/ignores"                     [("folder", "default")]                     (createIgnoresMap ["file1", "file2", "foo/bar"])-                   (Post.sendIgnores "default" ["file1", "file2", "foo/bar"])-        , testPostConfig "/rest/config" noParams+                   (Post.ignores "default" ["file1", "file2", "foo/bar"])+        , testPostConfig "/rest/system/config" noParams         ]     ]