Adding Suave Rest Api

SuaveRestApi/SuaveRestApi.sln

@@ -0,0 +1,22 @@
+
+Microsoft Visual Studio Solution File, Format Version 12.00
+# Visual Studio 2013
+VisualStudioVersion = 12.0.31101.0
+MinimumVisualStudioVersion = 10.0.40219.1
+Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "SuaveRestApi", "SuaveRestApi\SuaveRestApi.fsproj", "{81DA87E7-35C0-4117-8C0E-57EB553AB792}"
+EndProject
+Global
+	GlobalSection(SolutionConfigurationPlatforms) = preSolution
+		Debug|Any CPU = Debug|Any CPU
+		Release|Any CPU = Release|Any CPU
+	EndGlobalSection
+	GlobalSection(ProjectConfigurationPlatforms) = postSolution
+		{81DA87E7-35C0-4117-8C0E-57EB553AB792}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
+		{81DA87E7-35C0-4117-8C0E-57EB553AB792}.Debug|Any CPU.Build.0 = Debug|Any CPU
+		{81DA87E7-35C0-4117-8C0E-57EB553AB792}.Release|Any CPU.ActiveCfg = Release|Any CPU
+		{81DA87E7-35C0-4117-8C0E-57EB553AB792}.Release|Any CPU.Build.0 = Release|Any CPU
+	EndGlobalSection
+	GlobalSection(SolutionProperties) = preSolution
+		HideSolutionNode = FALSE
+	EndGlobalSection
+EndGlobal

SuaveRestApi/SuaveRestApi/App.config

@@ -0,0 +1,14 @@
+<?xml version="1.0" encoding="utf-8"?>
+<configuration>
+    <startup> 
+        <supportedRuntime version="v4.0" sku=".NETFramework,Version=v4.5" />
+    </startup>
+  <runtime>
+    <assemblyBinding xmlns="urn:schemas-microsoft-com:asm.v1">
+      <dependentAssembly>
+        <assemblyIdentity name="FSharp.Core" publicKeyToken="b03f5f7f11d50a3a" culture="neutral" />
+        <bindingRedirect oldVersion="0.0.0.0-4.3.1.0" newVersion="4.3.1.0" />
+      </dependentAssembly>
+    </assemblyBinding>
+  </runtime>
+</configuration>

SuaveRestApi/SuaveRestApi/App.fs

@@ -0,0 +1,36 @@
+namespace SuaveRestApi
+
+module App =
+
+    open SuaveRestApi.Db
+    open SuaveRestApi.MusicStoreDb
+    open SuaveRestApi.Rest
+    open Suave.Web
+    open Suave.Http
+
+    [<EntryPoint>]
+    let main argv =    
+
+        let personWebPart = rest "people" {
+            GetAll = Db.getPeople
+            GetById = Db.getPerson
+            Create = Db.createPerson
+            Update = Db.updatePerson
+            UpdateById = Db.updatePersonById
+            Delete = Db.deletePerson
+            IsExists = Db.isPersonExists
+        }
+
+        let albumWebPart = rest "albums" {
+            GetAll = MusicStoreDb.getAlbums
+            GetById = MusicStoreDb.getAlbumById
+            Create = MusicStoreDb.createAlbum
+            Update = MusicStoreDb.updateAlbum
+            UpdateById = MusicStoreDb.updateAlbumById
+            Delete = MusicStoreDb.deleteAlbum
+            IsExists = MusicStoreDb.isAlbumExists
+        }
+
+        startWebServer defaultConfig (choose [personWebPart;albumWebPart])
+        0 // return an integer exit code
+

SuaveRestApi/SuaveRestApi/Db.fs

@@ -0,0 +1,54 @@
+namespace SuaveRestApi.Db
+
+open System.Collections.Generic
+
+type Person = {
+    Id : int
+    Name : string
+    Age : int
+    Email : string
+}
+
+module Db =        
+
+    let peopleStorage = new Dictionary<int, Person>()
+    let getPeople () = 
+        peopleStorage.Values |> Seq.map (fun p -> p)
+    let getPerson id =
+        if peopleStorage.ContainsKey(id) then
+            Some peopleStorage.[id]
+        else
+            None
+    let createPerson person =
+        let id = peopleStorage.Values.Count + 1
+        let newPerson = {
+            Id = id
+            Name = person.Name
+            Age = person.Age
+            Email = person.Email
+        }
+        peopleStorage.Add(id, newPerson)
+        newPerson    
+
+    let updatePersonById personId personToBeUpdated =
+        if peopleStorage.ContainsKey(personId) then
+            let updatedPerson = {
+                Id = personId
+                Name = personToBeUpdated.Name
+                Age = personToBeUpdated.Age
+                Email = personToBeUpdated.Email
+            }
+            peopleStorage.[personId] <- updatedPerson
+
+            Some updatedPerson
+        else 
+            None
+
+    let updatePerson personToBeUpdated =
+        updatePersonById personToBeUpdated.Id personToBeUpdated 
+
+    let deletePerson personId = 
+        peopleStorage.Remove(personId) |> ignore
+
+    let isPersonExists  = peopleStorage.ContainsKey
+

SuaveRestApi/SuaveRestApi/MusicStoreDb.fs

@@ -0,0 +1,85 @@
+namespace SuaveRestApi.MusicStoreDb
+
+open FSharp.Data.Sql
+
+module MusicStoreDb = 
+    type Album = 
+        { 
+          AlbumId : int
+          ArtistId : int
+          GenreId : int
+          Title : string
+          Price : decimal}
+
+    type private Sql = SqlDataProvider< "Server=localhost;Database=SuaveMusicStore;Trusted_Connection=True;MultipleActiveResultSets=true;Integrated Security=SSPI;", DatabaseVendor=Common.DatabaseProviderTypes.MSSQLSERVER >
+
+    type DbContext = Sql.dataContext
+
+    type AlbumEntity = DbContext.``[dbo].[Albums]Entity``
+
+    let private getContext() = Sql.GetDataContext()
+
+    let firstOrNone s = s |> Seq.tryFind (fun _ -> true)
+
+    let mapToAlbum (albumEntity : AlbumEntity) =
+        {   
+            AlbumId = albumEntity.AlbumId
+            ArtistId = albumEntity.ArtistId
+            GenreId = albumEntity.GenreId
+            Title = albumEntity.Title
+            Price = albumEntity.Price
+        }
+
+    let getAlbums () = 
+        getContext().``[dbo].[Albums]``
+        |> Seq.map mapToAlbum
+
+    let getAlbumEntityById (ctx : DbContext) id = 
+        query { 
+        for album in ctx.``[dbo].[Albums]`` do
+            where (album.AlbumId = id)
+            select album
+        } |> firstOrNone
+
+    let getAlbumById id =
+        getAlbumEntityById (getContext()) id |> Option.map mapToAlbum
+
+    let createAlbum album =
+        let ctx = getContext()
+        let album = ctx.``[dbo].[Albums]``.Create(album.ArtistId, album.GenreId, album.Price, album.Title)
+        ctx.SubmitUpdates()
+        album |> mapToAlbum
+
+    let updateAlbumById id album =
+        let ctx = getContext()
+        let albumEntity = getAlbumEntityById ctx album.AlbumId
+        match albumEntity with
+        | None -> None
+        | Some a ->
+            a.ArtistId <- album.AlbumId
+            a.GenreId <- album.GenreId
+            a.Price <- album.Price
+            a.Title <- album.Title
+            ctx.SubmitUpdates()
+            Some album
+
+    let updateAlbum album =
+        updateAlbumById album.AlbumId album
+
+
+    let deleteAlbum id =
+        let ctx = getContext()
+        let albumEntity = getAlbumEntityById ctx id
+        match albumEntity with
+        | None -> ()
+        | Some a ->
+            a.Delete()
+            ctx.SubmitUpdates()
+
+    let isAlbumExists id =
+        let ctx = getContext()
+        let albumEntity = getAlbumEntityById ctx id
+        match albumEntity with
+        | None -> false
+        | Some _ -> true
+

SuaveRestApi/SuaveRestApi/RestFul.fs

@@ -0,0 +1,75 @@
+namespace SuaveRestApi.Rest
+
+open Newtonsoft.Json
+open Newtonsoft.Json.Serialization
+open Suave.Http
+open Suave.Http.Successful
+open Suave.Http.Applicatives
+open Suave.Types
+open Suave.Http.RequestErrors
+
+
+[<AutoOpen>]
+module RestFul =    
+
+    // 'a -> WebPart
+    let JSON v =     
+        let jsonSerializerSettings = new JsonSerializerSettings()
+        jsonSerializerSettings.ContractResolver <- new CamelCasePropertyNamesContractResolver()
+
+        JsonConvert.SerializeObject(v, jsonSerializerSettings)
+        |> OK 
+        >>= Writers.setMimeType "application/json; charset=utf-8"
+
+    let fromJson<'a> json =
+        JsonConvert.DeserializeObject(json, typeof<'a>) :?> 'a    
+
+    let getResourceFromReq<'a> (req : HttpRequest) = 
+        let getString rawForm = System.Text.Encoding.UTF8.GetString(rawForm)
+        req.rawForm |> getString |> fromJson<'a>
+
+    type RestResource<'a> = {
+        GetAll : unit -> 'a seq
+        GetById : int -> 'a option
+        IsExists : int -> bool
+        Create : 'a -> 'a
+        Update : 'a -> 'a option
+        UpdateById : int -> 'a -> 'a option
+        Delete : int -> unit
+    }
+
+    let rest resourceName resource =
+
+        let resourcePath = "/" + resourceName
+        let resourceIdPath = new PrintfFormat<(int -> string),unit,string,string,int>(resourcePath + "/%d")
+        let resourceCountPath = resourcePath + "/count"
+        let badRequest = BAD_REQUEST "Resource not found"
+
+        let handleResource requestError = function
+            | Some r -> r |> JSON
+            | _ -> requestError
+
+        let getAll= warbler (fun _ -> resource.GetAll () |> JSON)
+        let getResourceById = 
+            resource.GetById >> handleResource (NOT_FOUND "Resource not found")
+        let updateResourceById id =
+            request (getResourceFromReq >> (resource.UpdateById id) >> handleResource badRequest)
+
+        let deleteResourceById id =
+            resource.Delete id
+            NO_CONTENT
+
+        let isResourceExists id =
+            if resource.IsExists id then OK "" else NOT_FOUND ""
+
+        choose [
+            path resourcePath >>= choose [
+                GET >>= getAll
+                POST >>= request (getResourceFromReq >> resource.Create >> JSON)
+                PUT >>= request (getResourceFromReq >> resource.Update >> handleResource badRequest)
+            ]
+            DELETE >>= pathScan resourceIdPath deleteResourceById
+            GET >>= pathScan resourceIdPath getResourceById
+            PUT >>= pathScan resourceIdPath updateResourceById
+            HEAD >>= pathScan resourceIdPath isResourceExists
+        ]

SuaveRestApi/SuaveRestApi/SuaveRestApi.fsproj

@@ -0,0 +1,100 @@
+<?xml version="1.0" encoding="utf-8"?>
+<Project ToolsVersion="12.0" DefaultTargets="Build" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+  <Import Project="$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props" Condition="Exists('$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props')" />
+  <PropertyGroup>
+    <Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
+    <Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
+    <SchemaVersion>2.0</SchemaVersion>
+    <ProjectGuid>81da87e7-35c0-4117-8c0e-57eb553ab792</ProjectGuid>
+    <OutputType>Exe</OutputType>
+    <RootNamespace>SuaveRestApi</RootNamespace>
+    <AssemblyName>SuaveRestApi</AssemblyName>
+    <TargetFrameworkVersion>v4.5</TargetFrameworkVersion>
+    <AutoGenerateBindingRedirects>true</AutoGenerateBindingRedirects>
+    <TargetFSharpCoreVersion>4.3.1.0</TargetFSharpCoreVersion>
+    <Name>SuaveRestApi</Name>
+  </PropertyGroup>
+  <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
+    <DebugSymbols>true</DebugSymbols>
+    <DebugType>full</DebugType>
+    <Optimize>false</Optimize>
+    <Tailcalls>false</Tailcalls>
+    <OutputPath>bin\Debug\</OutputPath>
+    <DefineConstants>DEBUG;TRACE</DefineConstants>
+    <WarningLevel>3</WarningLevel>
+    <PlatformTarget>AnyCPU</PlatformTarget>
+    <DocumentationFile>bin\Debug\SuaveRestApi.XML</DocumentationFile>
+    <Prefer32Bit>true</Prefer32Bit>
+  </PropertyGroup>
+  <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
+    <DebugType>pdbonly</DebugType>
+    <Optimize>true</Optimize>
+    <Tailcalls>true</Tailcalls>
+    <OutputPath>bin\Release\</OutputPath>
+    <DefineConstants>TRACE</DefineConstants>
+    <WarningLevel>3</WarningLevel>
+    <PlatformTarget>AnyCPU</PlatformTarget>
+    <DocumentationFile>bin\Release\SuaveRestApi.XML</DocumentationFile>
+    <Prefer32Bit>true</Prefer32Bit>
+  </PropertyGroup>
+  <PropertyGroup>
+    <MinimumVisualStudioVersion Condition="'$(MinimumVisualStudioVersion)' == ''">11</MinimumVisualStudioVersion>
+  </PropertyGroup>
+  <Choose>
+    <When Condition="'$(VisualStudioVersion)' == '11.0'">
+      <PropertyGroup Condition="Exists('$(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets')">
+        <FSharpTargetsPath>$(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets</FSharpTargetsPath>
+      </PropertyGroup>
+    </When>
+    <Otherwise>
+      <PropertyGroup Condition="Exists('$(MSBuildExtensionsPath32)\Microsoft\VisualStudio\v$(VisualStudioVersion)\FSharp\Microsoft.FSharp.Targets')">
+        <FSharpTargetsPath>$(MSBuildExtensionsPath32)\Microsoft\VisualStudio\v$(VisualStudioVersion)\FSharp\Microsoft.FSharp.Targets</FSharpTargetsPath>
+      </PropertyGroup>
+    </Otherwise>
+  </Choose>
+  <Import Project="$(FSharpTargetsPath)" />
+  <ItemGroup>
+    <Compile Include="MusicStoreDb.fs" />
+    <Compile Include="Db.fs" />
+    <Compile Include="RestFul.fs" />
+    <Compile Include="App.fs" />
+    <None Include="App.config" />
+    <Content Include="packages.config" />
+  </ItemGroup>
+  <ItemGroup>
+    <Reference Include="FSharp.Core">
+      <HintPath>..\packages\FSharp.Core.3.1.2.1\lib\net40\FSharp.Core.dll</HintPath>
+      <Private>True</Private>
+    </Reference>
+    <Reference Include="FSharp.Data.SqlProvider">
+      <HintPath>..\packages\SQLProvider.0.0.9-alpha\lib\net40\FSharp.Data.SqlProvider.dll</HintPath>
+      <Private>True</Private>
+    </Reference>
+    <Reference Include="FsPickler">
+      <HintPath>..\packages\FsPickler.1.2.5\lib\net45\FsPickler.dll</HintPath>
+      <Private>True</Private>
+    </Reference>
+    <Reference Include="mscorlib" />
+    <Reference Include="Newtonsoft.Json">
+      <HintPath>..\packages\Newtonsoft.Json.6.0.8\lib\net45\Newtonsoft.Json.dll</HintPath>
+      <Private>True</Private>
+    </Reference>
+    <Reference Include="Suave">
+      <HintPath>..\packages\Suave.0.29.0-alpha\lib\net40\Suave.dll</HintPath>
+      <Private>True</Private>
+    </Reference>
+    <Reference Include="System" />
+    <Reference Include="System.Core" />
+    <Reference Include="System.Data" />
+    <Reference Include="System.Numerics" />
+    <Reference Include="System.Runtime.Serialization" />
+    <Reference Include="System.Xml" />
+  </ItemGroup>
+  <!-- To modify your build process, add your task inside one of the targets below and uncomment it. 
+       Other similar extension points exist, see Microsoft.Common.targets.
+  <Target Name="BeforeBuild">
+  </Target>
+  <Target Name="AfterBuild">
+  </Target>
+  -->
+</Project>